From fb633798af890d134e8ab7bf6c0f66b3d3b1e1a7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Apr 2022 12:40:00 +0200 Subject: [PATCH 01/99] following paper --- PRIVATE | 2 +- examples/config/phase/damage/anisobrittle_cubic.yaml | 2 +- examples/config/phase/damage/isobrittle_generic.yaml | 4 ++-- src/phase_damage.f90 | 4 +--- src/phase_damage_isobrittle.f90 | 2 +- 5 files changed, 6 insertions(+), 8 deletions(-) diff --git a/PRIVATE b/PRIVATE index 459326e98..dd7f4efd6 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 459326e9840c843ade72b04cf28e50889c9779f1 +Subproject commit dd7f4efd64ebadac74cab84f713a738c71d8b737 diff --git a/examples/config/phase/damage/anisobrittle_cubic.yaml b/examples/config/phase/damage/anisobrittle_cubic.yaml index 372fdc6d0..4f8db50ee 100644 --- a/examples/config/phase/damage/anisobrittle_cubic.yaml +++ b/examples/config/phase/damage/anisobrittle_cubic.yaml @@ -9,5 +9,5 @@ s_crit: [0.006666] dot_o: 1.e-3 q: 20 -D_11: 1.0 +l_c: 1.0 mu: 0.001 diff --git a/examples/config/phase/damage/isobrittle_generic.yaml b/examples/config/phase/damage/isobrittle_generic.yaml index 851302a49..9de78448d 100644 --- a/examples/config/phase/damage/isobrittle_generic.yaml +++ b/examples/config/phase/damage/isobrittle_generic.yaml @@ -2,6 +2,6 @@ type: isobrittle output: [f_phi] -W_crit: 1400000.0 -D_11: 1.0 +G: 1400000.0 +l_c: 1.0 mu: 0.001 diff --git a/src/phase_damage.f90 b/src/phase_damage.f90 index 9022131e2..5bf351dd0 100644 --- a/src/phase_damage.f90 +++ b/src/phase_damage.f90 @@ -105,9 +105,7 @@ module subroutine damage_init damage_active = .true. source => sources%get(1) param(ph)%mu = source%get_asFloat('mu') - param(ph)%D(1,1) = source%get_asFloat('D_11') - if (any(phase_lattice(ph) == ['hP','tI'])) param(ph)%D(3,3) = source%get_asFloat('D_33') - param(ph)%D = lattice_symmetrize_33(param(ph)%D,phase_lattice(ph)) + param(ph)%D = math_I3 * source%get_asFloat('l_c')**2 end if end do diff --git a/src/phase_damage_isobrittle.f90 b/src/phase_damage_isobrittle.f90 index 2d501b58f..353ce9f00 100644 --- a/src/phase_damage_isobrittle.f90 +++ b/src/phase_damage_isobrittle.f90 @@ -63,7 +63,7 @@ module function isobrittle_init() result(mySources) associate(prm => param(ph), dlt => deltaState(ph), stt => state(ph)) src => sources%get(1) - prm%W_crit = src%get_asFloat('W_crit') + prm%W_crit = src%get_asFloat('G')/src%get_asFloat('l_c') #if defined (__GFORTRAN__) prm%output = output_as1dString(src) From d3171e472417bbea8370f201b620f6593c885fbe Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 25 May 2022 18:41:13 +0200 Subject: [PATCH 02/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-400-g1dc5e353c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 00e433ed7..181f57ab6 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-395-g9696c1967 +3.0.0-alpha6-400-g1dc5e353c From e68441218698a91e541a02bfde1a960cf5675d30 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 26 May 2022 14:22:45 +0200 Subject: [PATCH 03/99] testing resolution-independent behavior --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 935a1d92a..073819b26 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 935a1d92a3d124ceaaf8729ad9bff4279fa5447b +Subproject commit 073819b26248e2915bd5f3b6de7d4e0d27a3d423 From a514d300607889baac65ea9d119170b864235011 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 26 May 2022 16:12:13 +0200 Subject: [PATCH 04/99] standardized names --- src/grid/discretization_grid.f90 | 8 ++--- src/grid/spectral_utilities.f90 | 58 ++++++++++++++++---------------- 2 files changed, 32 insertions(+), 34 deletions(-) diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index ddb36a246..901d35a9a 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -107,10 +107,8 @@ subroutine discretization_grid_init(restart) if (worldsize>cells(3)) call IO_error(894, ext_msg='number of processes exceeds cells(3)') - call fftw_mpi_init - devNull = fftw_mpi_local_size_3d(int(cells(3),C_INTPTR_T), & - int(cells(2),C_INTPTR_T), & - int(cells(1),C_INTPTR_T)/2+1, & + call fftw_mpi_init() + devNull = fftw_mpi_local_size_3d(int(cells(3),C_INTPTR_T),int(cells(2),C_INTPTR_T),int(cells(1)/2+1,C_INTPTR_T), & PETSC_COMM_WORLD, & z, & ! domain cells size along z z_offset) ! domain cells offset along z @@ -123,7 +121,7 @@ subroutine discretization_grid_init(restart) myGrid = [cells(1:2),cells3] mySize = [geomSize(1:2),size3] - call MPI_Gather(product(cells(1:2))*cells3Offset, 1_MPI_INTEGER_KIND,MPI_INTEGER,displs,& + call MPI_Gather(product(cells(1:2))*cells3Offset,1_MPI_INTEGER_KIND,MPI_INTEGER,displs,& 1_MPI_INTEGER_KIND,MPI_INTEGER,0_MPI_INTEGER_KIND,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' call MPI_Gather(product(myGrid), 1_MPI_INTEGER_KIND,MPI_INTEGER,sendcounts,& diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index c8321f83f..7b712c7dd 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -152,8 +152,8 @@ subroutine spectral_utilities_init() tensorField, & !< field containing data for FFTW in real and fourier space (in place) vectorField, & !< field containing data for FFTW in real space when debugging FFTW (no in place) scalarField !< field containing data for FFTW in real space when debugging FFTW (no in place) - integer(C_INTPTR_T), dimension(3) :: gridFFTW - integer(C_INTPTR_T) :: alloc_local, local_K, local_K_offset + integer(C_INTPTR_T), dimension(3) :: cellsFFTW + integer(C_INTPTR_T) :: alloc_local, z, devNull integer(C_INTPTR_T), parameter :: & scalarSize = 1_C_INTPTR_T, & vectorSize = 3_C_INTPTR_T, & @@ -262,68 +262,68 @@ subroutine spectral_utilities_init() !-------------------------------------------------------------------------------------------------- ! MPI allocation - gridFFTW = int(cells,C_INTPTR_T) - alloc_local = fftw_mpi_local_size_3d(gridFFTW(3), gridFFTW(2), gridFFTW(1)/2 +1, & - PETSC_COMM_WORLD, local_K, local_K_offset) + cellsFFTW = int(cells,C_INTPTR_T) + alloc_local = fftw_mpi_local_size_3d(cellsFFTW(3), cellsFFTW(2), cellsFFTW(1)/2 +1, & + PETSC_COMM_WORLD, z, devNull) allocate (xi1st (3,cells1Red,cells(2),cells3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for first derivatives, only half the size for first dimension allocate (xi2nd (3,cells1Red,cells(2),cells3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for second derivatives, only half the size for first dimension tensorField = fftw_alloc_complex(tensorSize*alloc_local) call c_f_pointer(tensorField, tensorField_real, [3_C_INTPTR_T,3_C_INTPTR_T, & - 2_C_INTPTR_T*(gridFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T),gridFFTW(2),local_K]) ! place a pointer for a real tensor representation + 2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T),cellsFFTW(2),z]) ! place a pointer for a real tensor representation call c_f_pointer(tensorField, tensorField_fourier, [3_C_INTPTR_T,3_C_INTPTR_T, & - gridFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T , gridFFTW(2),local_K]) ! place a pointer for a fourier tensor representation + cellsFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T , cellsFFTW(2),z]) ! place a pointer for a fourier tensor representation vectorField = fftw_alloc_complex(vectorSize*alloc_local) call c_f_pointer(vectorField, vectorField_real, [3_C_INTPTR_T,& - 2_C_INTPTR_T*(gridFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T),gridFFTW(2),local_K]) ! place a pointer for a real vector representation + 2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T),cellsFFTW(2),z]) ! place a pointer for a real vector representation call c_f_pointer(vectorField, vectorField_fourier,[3_C_INTPTR_T,& - gridFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T, gridFFTW(2),local_K]) ! place a pointer for a fourier vector representation + cellsFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T, cellsFFTW(2),z]) ! place a pointer for a fourier vector representation scalarField = fftw_alloc_complex(scalarSize*alloc_local) ! allocate data for real representation (no in place transform) call c_f_pointer(scalarField, scalarField_real, & - [2_C_INTPTR_T*(gridFFTW(1)/2_C_INTPTR_T + 1),gridFFTW(2),local_K]) ! place a pointer for a real scalar representation + [2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T + 1),cellsFFTW(2),z]) ! place a pointer for a real scalar representation call c_f_pointer(scalarField, scalarField_fourier, & - [ gridFFTW(1)/2_C_INTPTR_T + 1 ,gridFFTW(2),local_K]) ! place a pointer for a fourier scarlar representation + [ cellsFFTW(1)/2_C_INTPTR_T + 1 ,cellsFFTW(2),z]) ! place a pointer for a fourier scarlar representation !-------------------------------------------------------------------------------------------------- ! tensor MPI fftw plans - planTensorForth = fftw_mpi_plan_many_dft_r2c(3,gridFFTW(3:1:-1),tensorSize, & + planTensorForth = fftw_mpi_plan_many_dft_r2c(3,cellsFFTW(3:1:-1),tensorSize, & FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & tensorField_real,tensorField_fourier, & PETSC_COMM_WORLD,FFTW_planner_flag) - if (.not. c_associated(planTensorForth)) error stop 'FFTW error' - planTensorBack = fftw_mpi_plan_many_dft_c2r(3,gridFFTW(3:1:-1),tensorSize, & - FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, & + if (.not. c_associated(planTensorForth)) error stop 'FFTW error r2c tensor' + planTensorBack = fftw_mpi_plan_many_dft_c2r(3,cellsFFTW(3:1:-1),tensorSize, & + FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & tensorField_fourier,tensorField_real, & - PETSC_COMM_WORLD, FFTW_planner_flag) - if (.not. c_associated(planTensorBack)) error stop 'FFTW error' + PETSC_COMM_WORLD,FFTW_planner_flag) + if (.not. c_associated(planTensorBack)) error stop 'FFTW error c2r tensor' !-------------------------------------------------------------------------------------------------- ! vector MPI fftw plans - planVectorForth = fftw_mpi_plan_many_dft_r2c(3,gridFFTW(3:1:-1),vectorSize, & + planVectorForth = fftw_mpi_plan_many_dft_r2c(3,cellsFFTW(3:1:-1),vectorSize, & FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & vectorField_real,vectorField_fourier, & PETSC_COMM_WORLD,FFTW_planner_flag) - if (.not. c_associated(planVectorForth)) error stop 'FFTW error' - planVectorBack = fftw_mpi_plan_many_dft_c2r(3,gridFFTW(3:1:-1),vectorSize, & - FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, & + if (.not. c_associated(planVectorForth)) error stop 'FFTW error r2c vector' + planVectorBack = fftw_mpi_plan_many_dft_c2r(3,cellsFFTW(3:1:-1),vectorSize, & + FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & vectorField_fourier,vectorField_real, & - PETSC_COMM_WORLD, FFTW_planner_flag) - if (.not. c_associated(planVectorBack)) error stop 'FFTW error' + PETSC_COMM_WORLD,FFTW_planner_flag) + if (.not. c_associated(planVectorBack)) error stop 'FFTW error c2r vector' !-------------------------------------------------------------------------------------------------- ! scalar MPI fftw plans - planScalarForth = fftw_mpi_plan_many_dft_r2c(3,gridFFTW(3:1:-1),scalarSize, & + planScalarForth = fftw_mpi_plan_dft_r2c(3,cellsFFTW(3:1:-1),scalarSize, & FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & scalarField_real,scalarField_fourier, & PETSC_COMM_WORLD,FFTW_planner_flag) - if (.not. c_associated(planScalarForth)) error stop 'FFTW error' - planScalarBack = fftw_mpi_plan_many_dft_c2r(3,gridFFTW(3:1:-1),scalarSize, & - FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, & + if (.not. c_associated(planScalarForth)) error stop 'FFTW error r2c scalar' + planScalarBack = fftw_mpi_plan_many_dft_c2r(3,cellsFFTW(3:1:-1),scalarSize, & + FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & scalarField_fourier,scalarField_real, & - PETSC_COMM_WORLD, FFTW_planner_flag) - if (.not. c_associated(planScalarBack)) error stop 'FFTW error' + PETSC_COMM_WORLD,FFTW_planner_flag) + if (.not. c_associated(planScalarBack)) error stop 'FFTW error c2r scalar' !-------------------------------------------------------------------------------------------------- ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around) From 82cad00f8199b6fa19f76d9beb13b3c1c486b928 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 26 May 2022 19:07:23 +0200 Subject: [PATCH 05/99] simplified interface --- src/grid/spectral_utilities.f90 | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 7b712c7dd..5c8936b14 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -297,7 +297,7 @@ subroutine spectral_utilities_init() FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & tensorField_fourier,tensorField_real, & PETSC_COMM_WORLD,FFTW_planner_flag) - if (.not. c_associated(planTensorBack)) error stop 'FFTW error c2r tensor' + if (.not. c_associated(planTensorBack)) error stop 'FFTW error c2r tensor' !-------------------------------------------------------------------------------------------------- ! vector MPI fftw plans @@ -310,20 +310,18 @@ subroutine spectral_utilities_init() FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & vectorField_fourier,vectorField_real, & PETSC_COMM_WORLD,FFTW_planner_flag) - if (.not. c_associated(planVectorBack)) error stop 'FFTW error c2r vector' + if (.not. c_associated(planVectorBack)) error stop 'FFTW error c2r vector' !-------------------------------------------------------------------------------------------------- ! scalar MPI fftw plans - planScalarForth = fftw_mpi_plan_dft_r2c(3,cellsFFTW(3:1:-1),scalarSize, & - FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & - scalarField_real,scalarField_fourier, & - PETSC_COMM_WORLD,FFTW_planner_flag) + planScalarForth = fftw_mpi_plan_dft_r2c_3d(cellsFFTW(3),cellsFFTW(2),cellsFFTW(1), & + scalarField_real,scalarField_fourier, & + PETSC_COMM_WORLD,FFTW_planner_flag) if (.not. c_associated(planScalarForth)) error stop 'FFTW error r2c scalar' - planScalarBack = fftw_mpi_plan_many_dft_c2r(3,cellsFFTW(3:1:-1),scalarSize, & - FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & - scalarField_fourier,scalarField_real, & - PETSC_COMM_WORLD,FFTW_planner_flag) - if (.not. c_associated(planScalarBack)) error stop 'FFTW error c2r scalar' + planScalarBack = fftw_mpi_plan_dft_c2r_3d(cellsFFTW(3),cellsFFTW(2),cellsFFTW(1), & + scalarField_fourier,scalarField_real, & + PETSC_COMM_WORLD,FFTW_planner_flag) + if (.not. c_associated(planScalarBack)) error stop 'FFTW error c2r scalar' !-------------------------------------------------------------------------------------------------- ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around) From 19b78cb647fc10a30d470d2e3f5e31981c208453 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 26 May 2022 19:15:25 +0200 Subject: [PATCH 06/99] easier to read --- src/grid/spectral_utilities.f90 | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 5c8936b14..9f3062d89 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -269,22 +269,22 @@ subroutine spectral_utilities_init() allocate (xi2nd (3,cells1Red,cells(2),cells3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for second derivatives, only half the size for first dimension tensorField = fftw_alloc_complex(tensorSize*alloc_local) - call c_f_pointer(tensorField, tensorField_real, [3_C_INTPTR_T,3_C_INTPTR_T, & - 2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T),cellsFFTW(2),z]) ! place a pointer for a real tensor representation - call c_f_pointer(tensorField, tensorField_fourier, [3_C_INTPTR_T,3_C_INTPTR_T, & - cellsFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T , cellsFFTW(2),z]) ! place a pointer for a fourier tensor representation + call c_f_pointer(tensorField,tensorField_real, & + [3_C_INTPTR_T,3_C_INTPTR_T,2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) + call c_f_pointer(tensorField,tensorField_fourier, & + [3_C_INTPTR_T,3_C_INTPTR_T, cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T, cellsFFTW(2),z]) vectorField = fftw_alloc_complex(vectorSize*alloc_local) - call c_f_pointer(vectorField, vectorField_real, [3_C_INTPTR_T,& - 2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T),cellsFFTW(2),z]) ! place a pointer for a real vector representation - call c_f_pointer(vectorField, vectorField_fourier,[3_C_INTPTR_T,& - cellsFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T, cellsFFTW(2),z]) ! place a pointer for a fourier vector representation + call c_f_pointer(vectorField,vectorField_real, & + [3_C_INTPTR_T,2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) + call c_f_pointer(vectorField,vectorField_fourier, & + [3_C_INTPTR_T, cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T, cellsFFTW(2),z]) - scalarField = fftw_alloc_complex(scalarSize*alloc_local) ! allocate data for real representation (no in place transform) - call c_f_pointer(scalarField, scalarField_real, & - [2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T + 1),cellsFFTW(2),z]) ! place a pointer for a real scalar representation - call c_f_pointer(scalarField, scalarField_fourier, & - [ cellsFFTW(1)/2_C_INTPTR_T + 1 ,cellsFFTW(2),z]) ! place a pointer for a fourier scarlar representation + scalarField = fftw_alloc_complex(scalarSize*alloc_local) + call c_f_pointer(scalarField,scalarField_real, & + [2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) + call c_f_pointer(scalarField,scalarField_fourier, & + [ cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T, cellsFFTW(2),z]) !-------------------------------------------------------------------------------------------------- ! tensor MPI fftw plans From 724c4fcf5d8962bb40e1f44b5857638ecde49bca Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 00:15:50 +0200 Subject: [PATCH 07/99] not used ip,el,g is anyways not flexible enough. Remove unused arguments before developing a more flexible approach --- src/IO.f90 | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 047d11add..d2b1017e1 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -357,10 +357,10 @@ end function IO_stringAsBool !-------------------------------------------------------------------------------------------------- !> @brief Write error statements to standard out and terminate the run with exit #9xxx !-------------------------------------------------------------------------------------------------- -subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) +subroutine IO_error(error_ID,el,ip,ext_msg) integer, intent(in) :: error_ID - integer, optional, intent(in) :: el,ip,g,instance + integer, optional, intent(in) :: el,ip character(len=*), optional, intent(in) :: ext_msg external :: quit @@ -564,10 +564,6 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' if (present(ip)) & write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│' - if (present(g)) & - write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│' - if (present(instance)) & - write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at instance ',instance, '│' write(IO_STDERR,'(a,69x,a)') ' │', '│' write(IO_STDERR,'(a)') ' └'//IO_DIVIDER//'┘' flush(IO_STDERR) @@ -580,10 +576,10 @@ end subroutine IO_error !-------------------------------------------------------------------------------------------------- !> @brief Write warning statement to standard out. !-------------------------------------------------------------------------------------------------- -subroutine IO_warning(warning_ID,el,ip,g,ext_msg) +subroutine IO_warning(warning_ID,el,ip,ext_msg) integer, intent(in) :: warning_ID - integer, optional, intent(in) :: el,ip,g + integer, optional, intent(in) :: el,ip character(len=*), optional, intent(in) :: ext_msg character(len=:), allocatable :: msg @@ -591,7 +587,7 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) select case (warning_ID) case (47) - msg = 'no valid parameter for FFTW, using FFTW_PATIENT' + msg = 'invalid parameter for FFTW, using FFTW_PATIENT' case (207) msg = 'line truncated' case (600) @@ -621,8 +617,6 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' if (present(ip)) & write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│' - if (present(g)) & - write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│' write(IO_STDERR,'(a,69x,a)') ' │', '│' write(IO_STDERR,'(a)') ' └'//IO_DIVIDER//'┘' flush(IO_STDERR) From 7a23699aa4b495b4d823ace13aef719859d66c33 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 00:24:40 +0200 Subject: [PATCH 08/99] not needed error occurs in --- src/phase_mechanical_plastic_dislotungsten.f90 | 2 +- src/phase_mechanical_plastic_dislotwin.f90 | 2 +- src/phase_mechanical_plastic_isotropic.f90 | 2 +- src/phase_mechanical_plastic_kinehardening.f90 | 2 +- src/phase_mechanical_plastic_nonlocal.f90 | 2 +- src/phase_mechanical_plastic_phenopowerlaw.f90 | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/phase_mechanical_plastic_dislotungsten.f90 b/src/phase_mechanical_plastic_dislotungsten.f90 index 5a6ac8f5c..9e72a1ebd 100644 --- a/src/phase_mechanical_plastic_dislotungsten.f90 +++ b/src/phase_mechanical_plastic_dislotungsten.f90 @@ -252,7 +252,7 @@ module function plastic_dislotungsten_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(dislotungsten)') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)) end do diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index 3ecd13cc7..a29efeb56 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -430,7 +430,7 @@ module function plastic_dislotwin_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(dislotwin)') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)) end do diff --git a/src/phase_mechanical_plastic_isotropic.f90 b/src/phase_mechanical_plastic_isotropic.f90 index 49efc9fae..868200aee 100644 --- a/src/phase_mechanical_plastic_isotropic.f90 +++ b/src/phase_mechanical_plastic_isotropic.f90 @@ -135,7 +135,7 @@ module function plastic_isotropic_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(isotropic)') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)) end do diff --git a/src/phase_mechanical_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90 index 0f6bd53d4..bc8c7df4e 100644 --- a/src/phase_mechanical_plastic_kinehardening.f90 +++ b/src/phase_mechanical_plastic_kinehardening.f90 @@ -224,7 +224,7 @@ module function plastic_kinehardening_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(kinehardening)') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)) end do diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index dbc02b7a4..4995f15d2 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -504,7 +504,7 @@ module function plastic_nonlocal_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(nonlocal)') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)) end do diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 index 0b018562c..f0dc04869 100644 --- a/src/phase_mechanical_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -269,7 +269,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(phenopowerlaw)') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)) end do From d5db083fec51a2a957edb757560310f69673bc19 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 00:25:25 +0200 Subject: [PATCH 09/99] more convenient to see all invalid parameters --- src/grid/grid_mech_FEM.f90 | 16 ++++++++----- src/grid/grid_mech_spectral_basic.f90 | 16 ++++++++----- src/grid/grid_mech_spectral_polarisation.f90 | 24 ++++++++++++-------- src/quit.f90 | 10 ++++---- 4 files changed, 39 insertions(+), 27 deletions(-) diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 53d788987..52be43362 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -115,6 +115,8 @@ subroutine grid_mechanical_FEM_init class(tNode), pointer :: & num_grid, & debug_grid + character(len=pStringLen) :: & + extmsg = '' print'(/,1x,a)', '<<<+- grid_mechanical_FEM init -+>>>'; flush(IO_STDOUT) @@ -134,12 +136,14 @@ subroutine grid_mechanical_FEM_init num%itmin = num_grid%get_asInt ('itmin',defaultVal=1) num%itmax = num_grid%get_asInt ('itmax',defaultVal=250) - if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol') - if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol') - if (num%eps_stress_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_stress_atol') - if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol') - if (num%itmax <= 1) call IO_error(301,ext_msg='itmax') - if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin') + if (num%eps_div_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_div_atol' + if (num%eps_div_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_div_rtol' + if (num%eps_stress_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_atol' + if (num%eps_stress_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_rtol' + if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax' + if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin' + + if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg)) !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index c0b85d00e..7931be0c7 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -117,6 +117,8 @@ subroutine grid_mechanical_spectral_basic_init class (tNode), pointer :: & num_grid, & debug_grid + character(len=pStringLen) :: & + extmsg = '' print'(/,1x,a)', '<<<+- grid_mechanical_spectral_basic init -+>>>'; flush(IO_STDOUT) @@ -143,12 +145,14 @@ subroutine grid_mechanical_spectral_basic_init num%itmin = num_grid%get_asInt ('itmin',defaultVal=1) num%itmax = num_grid%get_asInt ('itmax',defaultVal=250) - if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol') - if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol') - if (num%eps_stress_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_stress_atol') - if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol') - if (num%itmax <= 1) call IO_error(301,ext_msg='itmax') - if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin') + if (num%eps_div_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_div_atol' + if (num%eps_div_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_div_rtol' + if (num%eps_stress_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_atol' + if (num%eps_stress_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_rtol' + if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax' + if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin' + + if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg)) !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index ec27c7390..198e333d5 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -130,6 +130,8 @@ subroutine grid_mechanical_spectral_polarisation_init class (tNode), pointer :: & num_grid, & debug_grid + character(len=pStringLen) :: & + extmsg = '' print'(/,1x,a)', '<<<+- grid_mechanical_spectral_polarization init -+>>>'; flush(IO_STDOUT) @@ -157,16 +159,18 @@ subroutine grid_mechanical_spectral_polarisation_init num%alpha = num_grid%get_asFloat('alpha', defaultVal=1.0_pReal) num%beta = num_grid%get_asFloat('beta', defaultVal=1.0_pReal) - if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol') - if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol') - if (num%eps_curl_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_curl_atol') - if (num%eps_curl_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_curl_rtol') - if (num%eps_stress_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_stress_atol') - if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol') - if (num%itmax <= 1) call IO_error(301,ext_msg='itmax') - if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin') - if (num%alpha <= 0.0_pReal .or. num%alpha > 2.0_pReal) call IO_error(301,ext_msg='alpha') - if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal) call IO_error(301,ext_msg='beta') + if (num%eps_div_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_div_atol' + if (num%eps_div_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_div_rtol' + if (num%eps_curl_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_curl_atol' + if (num%eps_curl_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_curl_rtol' + if (num%eps_stress_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_atol' + if (num%eps_stress_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_rtol' + if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax' + if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin' + if (num%alpha <= 0.0_pReal .or. num%alpha > 2.0_pReal) extmsg = trim(extmsg)//' alpha' + if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal) extmsg = trim(extmsg)//' beta' + + if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg)) !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc diff --git a/src/quit.f90 b/src/quit.f90 index 3c5f5e6f2..aa8bcb0fb 100644 --- a/src/quit.f90 +++ b/src/quit.f90 @@ -18,22 +18,22 @@ subroutine quit(stop_id) integer :: err_HDF5 integer(MPI_INTEGER_KIND) :: err_MPI PetscErrorCode :: err_PETSc - + call h5open_f(err_HDF5) if (err_HDF5 /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in h5open_f ',err_HDF5 ! prevents error if not opened yet call h5close_f(err_HDF5) if (err_HDF5 /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in h5close_f ',err_HDF5 - + call PetscFinalize(err_PETSc) CHKERRQ(err_PETSc) - + #ifdef _OPENMP call MPI_finalize(err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in MPI_finalize',err_MPI #else err_MPI = 0_MPI_INTEGER_KIND #endif - + call date_and_time(values = dateAndTime) write(6,'(/,a)') ' DAMASK terminated on:' write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& @@ -42,7 +42,7 @@ subroutine quit(stop_id) write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& dateAndTime(6),':',& dateAndTime(7) - + if (stop_id == 0 .and. & err_HDF5 == 0 .and. & err_MPI == 0_MPI_INTEGER_KIND .and. & From 1d4c476cd4644feb1a287424d809dcc4b607eb29 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 06:30:25 +0200 Subject: [PATCH 10/99] collect errors for more helpful message --- src/phase.f90 | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/src/phase.f90 b/src/phase.f90 index 2ce559a99..af7197f7b 100644 --- a/src/phase.f90 +++ b/src/phase.f90 @@ -539,7 +539,8 @@ subroutine crystallite_init() class(tNode), pointer :: & num_crystallite, & phases - + character(len=pStringLen) :: & + extmsg = '' num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) @@ -555,22 +556,19 @@ subroutine crystallite_init() num%nState = num_crystallite%get_asInt ('nState', defaultVal=20) num%nStress = num_crystallite%get_asInt ('nStress', defaultVal=40) - if (num%subStepMinCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinCryst') - if (num%subStepSizeCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeCryst') - if (num%stepIncreaseCryst <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseCryst') - - if (num%subStepSizeLp <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLp') - if (num%subStepSizeLi <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLi') - - if (num%rtol_crystalliteState <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteState') - if (num%rtol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteStress') - if (num%atol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='atol_crystalliteStress') - - if (num%iJacoLpresiduum < 1) call IO_error(301,ext_msg='iJacoLpresiduum') - - if (num%nState < 1) call IO_error(301,ext_msg='nState') - if (num%nStress< 1) call IO_error(301,ext_msg='nStress') + if (num%subStepMinCryst <= 0.0_pReal) extmsg = trim(extmsg)//' subStepMinCryst' + if (num%subStepSizeCryst <= 0.0_pReal) extmsg = trim(extmsg)//' subStepSizeCryst' + if (num%stepIncreaseCryst <= 0.0_pReal) extmsg = trim(extmsg)//' stepIncreaseCryst' + if (num%subStepSizeLp <= 0.0_pReal) extmsg = trim(extmsg)//' subStepSizeLp' + if (num%subStepSizeLi <= 0.0_pReal) extmsg = trim(extmsg)//' subStepSizeLi' + if (num%rtol_crystalliteState <= 0.0_pReal) extmsg = trim(extmsg)//' rtol_crystalliteState' + if (num%rtol_crystalliteStress <= 0.0_pReal) extmsg = trim(extmsg)//' rtol_crystalliteStress' + if (num%atol_crystalliteStress <= 0.0_pReal) extmsg = trim(extmsg)//' atol_crystalliteStress' + if (num%iJacoLpresiduum < 1) extmsg = trim(extmsg)//' iJacoLpresiduum' + if (num%nState < 1) extmsg = trim(extmsg)//' nState' + if (num%nStress < 1) extmsg = trim(extmsg)//' nStress' + if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg)) phases => config_material%get('phase') From 79fad5ca195d3ee952746d7b1697f52e0893923a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 06:41:15 +0200 Subject: [PATCH 11/99] IP was only used for an argument that is NOT the IP ID --- src/IO.f90 | 7 +++---- src/Marc/discretization_Marc.f90 | 3 ++- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index d2b1017e1..244d34845 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -357,10 +357,10 @@ end function IO_stringAsBool !-------------------------------------------------------------------------------------------------- !> @brief Write error statements to standard out and terminate the run with exit #9xxx !-------------------------------------------------------------------------------------------------- -subroutine IO_error(error_ID,el,ip,ext_msg) +subroutine IO_error(error_ID,el,ext_msg) integer, intent(in) :: error_ID - integer, optional, intent(in) :: el,ip + integer, optional, intent(in) :: el character(len=*), optional, intent(in) :: ext_msg external :: quit @@ -562,8 +562,6 @@ subroutine IO_error(error_ID,el,ip,ext_msg) endif if (present(el)) & write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' - if (present(ip)) & - write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│' write(IO_STDERR,'(a,69x,a)') ' │', '│' write(IO_STDERR,'(a)') ' └'//IO_DIVIDER//'┘' flush(IO_STDERR) @@ -585,6 +583,7 @@ subroutine IO_warning(warning_ID,el,ip,ext_msg) character(len=:), allocatable :: msg character(len=pStringLen) :: formatString + select case (warning_ID) case (47) msg = 'invalid parameter for FFTW, using FFTW_PATIENT' diff --git a/src/Marc/discretization_Marc.f90 b/src/Marc/discretization_Marc.f90 index c1525b05e..10d7ca46a 100644 --- a/src/Marc/discretization_Marc.f90 +++ b/src/Marc/discretization_Marc.f90 @@ -594,7 +594,7 @@ subroutine inputRead_elemType(elem, & t = mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2)) call elem%init(t) else - if (t /= mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2))) call IO_error(191,el=t,ip=i) + if (t /= mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2))) call IO_error(191,el=t) endif remainingChunks = elem%nNodes - (chunkPos(1) - 2) do while(remainingChunks > 0) @@ -616,6 +616,7 @@ subroutine inputRead_elemType(elem, & character(len=*), intent(in) :: what + select case (IO_lc(what)) case ( '6') mapElemtype = 1 ! Two-dimensional Plane Strain Triangle From 5f0ae4fe7aa8f728abd1da47e5df434e4be8ddf7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 06:41:55 +0200 Subject: [PATCH 12/99] user errors are catched earlier internal errors (essentially programming faults) should stop with 'error stop' --- src/Marc/element.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Marc/element.f90 b/src/Marc/element.f90 index 295a41547..b53322f34 100644 --- a/src/Marc/element.f90 +++ b/src/Marc/element.f90 @@ -714,7 +714,7 @@ subroutine tElement_init(self,elemType) case(13) self%cellNodeParentNodeWeights = CELLNODEPARENTNODEWEIGHTS13 case default - call IO_error(0,ext_msg='invalid element type') + error stop 'invalid element type' end select From f90523eb07dac2855823397fcd9729818a8fc93f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 07:28:34 +0200 Subject: [PATCH 13/99] more flexible reporting --- src/IO.f90 | 25 +++++++++++++++++-------- src/Marc/materialpoint_Marc.f90 | 3 ++- src/grid/spectral_utilities.f90 | 2 +- src/phase_mechanical.f90 | 8 ++++---- 4 files changed, 24 insertions(+), 14 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 244d34845..f0d8c9df4 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -95,7 +95,7 @@ function IO_readlines(fileName) result(fileContent) if (endPos - startPos > pStringLen-1) then line = rawData(startPos:startPos+pStringLen-1) if (.not. warned) then - call IO_warning(207,ext_msg=trim(fileName),el=l) + call IO_warning(207,trim(fileName),label1='line',ID1=l) warned = .true. endif else @@ -574,16 +574,19 @@ end subroutine IO_error !-------------------------------------------------------------------------------------------------- !> @brief Write warning statement to standard out. !-------------------------------------------------------------------------------------------------- -subroutine IO_warning(warning_ID,el,ip,ext_msg) +subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2) integer, intent(in) :: warning_ID - integer, optional, intent(in) :: el,ip - character(len=*), optional, intent(in) :: ext_msg + character(len=*), optional, intent(in) :: ext_msg,label1,label2 + integer, optional, intent(in) :: ID1,ID2 character(len=:), allocatable :: msg character(len=pStringLen) :: formatString + if (present(ID1) .and. .not. present(label1)) error stop 'warning value without label (1)' + if (present(ID2) .and. .not. present(label2)) error stop 'warning value without label (2)' + select case (warning_ID) case (47) msg = 'invalid parameter for FFTW, using FFTW_PATIENT' @@ -612,10 +615,16 @@ subroutine IO_warning(warning_ID,el,ip,ext_msg) max(1,72-len_trim(ext_msg)-4),'x,a)' write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│' endif - if (present(el)) & - write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' - if (present(ip)) & - write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│' + if (present(label1)) then + write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',& + max(1,72-len_trim(label1)-9-7),'x,a)' + write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│' + endif + if (present(label2)) then + write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',& + max(1,72-len_trim(label2)-9-7),'x,a)' + write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│' + endif write(IO_STDERR,'(a,69x,a)') ' │', '│' write(IO_STDERR,'(a)') ' └'//IO_DIVIDER//'┘' flush(IO_STDERR) diff --git a/src/Marc/materialpoint_Marc.f90 b/src/Marc/materialpoint_Marc.f90 index 79b06b80d..2ad98109d 100644 --- a/src/Marc/materialpoint_Marc.f90 +++ b/src/Marc/materialpoint_Marc.f90 @@ -240,7 +240,8 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, endif - if (all(abs(materialpoint_dcsdE(1:6,1:6,ip,elCP)) < 1e-10_pReal)) call IO_warning(601,elCP,ip) + if (all(abs(materialpoint_dcsdE(1:6,1:6,ip,elCP)) < 1e-10_pReal)) & + call IO_warning(601,label1='element (CP)',ID1=elCP,label2='IP',ID2=ip) cauchyStress = materialpoint_cs (1:6, ip,elCP) jacobian = materialpoint_dcsdE(1:6,1:6,ip,elCP) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index c8321f83f..0c114f8cb 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -249,7 +249,7 @@ subroutine spectral_utilities_init() case('fftw_exhaustive') FFTW_planner_flag = FFTW_EXHAUSTIVE case default - call IO_warning(warning_ID=47,ext_msg=trim(IO_lc(num_grid%get_asString('fftw_plan_mode')))) + call IO_warning(47,trim(num_grid%get_asString('fftw_plan_mode'))) FFTW_planner_flag = FFTW_MEASURE end select diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90 index 88b86a8d9..afde549fc 100644 --- a/src/phase_mechanical.f90 +++ b/src/phase_mechanical.f90 @@ -1167,8 +1167,8 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF) enddo; enddo call math_invert(temp_99,error,math_3333to99(lhs_3333)) if (error) then - call IO_warning(warning_ID=600, & - ext_msg='inversion error in analytic tangent calculation') + call IO_warning(600,'inversion error in analytic tangent calculation', & + label1='phase',ID1=ph,label2='entry',ID2=en) dFidS = 0.0_pReal else dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) @@ -1201,8 +1201,8 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF) call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) if (error) then - call IO_warning(warning_ID=600, & - ext_msg='inversion error in analytic tangent calculation') + call IO_warning(600,'inversion error in analytic tangent calculation', & + label1='phase',ID1=ph,label2='entry',ID2=en) dSdF = rhs_3333 else dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) From f31dd8cbe8228bcd446d5b0185b27884b2132d3b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 08:34:52 +0200 Subject: [PATCH 14/99] unknown error/warning numbers are internal errors --- src/IO.f90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index f0d8c9df4..11af5e1b6 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -540,10 +540,8 @@ subroutine IO_error(error_ID,el,ext_msg) case (950) msg = 'max number of cut back exceeded, terminating' -!------------------------------------------------------------------------------------------------- -! general error messages case default - msg = 'unknown error number...' + error stop 'invalid error number' end select @@ -599,7 +597,7 @@ subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2) case (709) msg = 'read only the first document' case default - msg = 'unknown warning number' + error stop 'invalid warning number' end select !$OMP CRITICAL (write2out) @@ -667,6 +665,7 @@ subroutine selfTest() integer, dimension(:), allocatable :: chunkPos character(len=:), allocatable :: str + if(dNeq(1.0_pReal, IO_stringAsFloat('1.0'))) error stop 'IO_stringAsFloat' if(dNeq(1.0_pReal, IO_stringAsFloat('1e0'))) error stop 'IO_stringAsFloat' if(dNeq(0.1_pReal, IO_stringAsFloat('1e-1'))) error stop 'IO_stringAsFloat' From f7d23ad1511254a8b5b02b2159275b219a8f2516 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 08:40:01 +0200 Subject: [PATCH 15/99] internal variable, no prefix needed --- src/IO.f90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 11af5e1b6..951bd6938 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -25,10 +25,10 @@ module IO CR = achar(13), & LF = IO_EOL character(len=*), parameter :: & - IO_DIVIDER = '───────────────────'//& - '───────────────────'//& - '───────────────────'//& - '────────────' + DIVIDER = '───────────────────'//& + '───────────────────'//& + '───────────────────'//& + '────────────' public :: & IO_init, & @@ -546,10 +546,10 @@ subroutine IO_error(error_ID,el,ext_msg) end select !$OMP CRITICAL (write2out) - write(IO_STDERR,'(/,a)') ' ┌'//IO_DIVIDER//'┐' + write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐' write(IO_STDERR,'(a,24x,a,40x,a)') ' │','error', '│' write(IO_STDERR,'(a,24x,i3,42x,a)') ' │',error_ID, '│' - write(IO_STDERR,'(a)') ' ├'//IO_DIVIDER//'┤' + write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤' write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',& max(1,72-len_trim(msg)-4),'x,a)' write(IO_STDERR,formatString) '│ ',trim(msg), '│' @@ -561,7 +561,7 @@ subroutine IO_error(error_ID,el,ext_msg) if (present(el)) & write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' write(IO_STDERR,'(a,69x,a)') ' │', '│' - write(IO_STDERR,'(a)') ' └'//IO_DIVIDER//'┘' + write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘' flush(IO_STDERR) call quit(9000+error_ID) !$OMP END CRITICAL (write2out) @@ -601,10 +601,10 @@ subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2) end select !$OMP CRITICAL (write2out) - write(IO_STDERR,'(/,a)') ' ┌'//IO_DIVIDER//'┐' + write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐' write(IO_STDERR,'(a,24x,a,38x,a)') ' │','warning', '│' write(IO_STDERR,'(a,24x,i3,42x,a)') ' │',warning_ID, '│' - write(IO_STDERR,'(a)') ' ├'//IO_DIVIDER//'┤' + write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤' write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',& max(1,72-len_trim(msg)-4),'x,a)' write(IO_STDERR,formatString) '│ ',trim(msg), '│' @@ -624,7 +624,7 @@ subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2) write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│' endif write(IO_STDERR,'(a,69x,a)') ' │', '│' - write(IO_STDERR,'(a)') ' └'//IO_DIVIDER//'┘' + write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘' flush(IO_STDERR) !$OMP END CRITICAL (write2out) From cfa2be44e9ffead434a0fb7e5886caae28ea9a62 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 08:48:42 +0200 Subject: [PATCH 16/99] internal errors should trigger error stop --- src/lattice.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index afff2a309..1c1cdf67a 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1431,7 +1431,7 @@ function lattice_SchmidMatrix_slip(Nslip,lattice,cOverA) result(SchmidMatrix) do i = 1, sum(Nslip) SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & - call IO_error(0,i,ext_msg = 'dilatational Schmid matrix for slip') + error stop 'dilatational Schmid matrix for slip' enddo end function lattice_SchmidMatrix_slip @@ -1478,7 +1478,7 @@ function lattice_SchmidMatrix_twin(Ntwin,lattice,cOverA) result(SchmidMatrix) do i = 1, sum(Ntwin) SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & - call IO_error(0,i,ext_msg = 'dilatational Schmid matrix for twin') + error stop 'dilatational Schmid matrix for twin' enddo end function lattice_SchmidMatrix_twin From 6c6b3e64b3b84ed01890e6e68bf8594dd26b9bf9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 09:29:42 +0200 Subject: [PATCH 17/99] more flexible reporting --- src/IO.f90 | 44 ++++++++++++++++++-------------- src/Marc/discretization_Marc.f90 | 15 ++++++----- src/grid/DAMASK_grid.f90 | 2 +- src/lattice.f90 | 2 +- 4 files changed, 35 insertions(+), 28 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 951bd6938..01fca31bd 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -129,7 +129,7 @@ function IO_read(fileName) result(fileContent) inquire(file = fileName, size=fileLength) open(newunit=fileUnit, file=fileName, access='stream',& status='old', position='rewind', action='read',iostat=myStat) - if (myStat /= 0) call IO_error(100,ext_msg=trim(fileName)) + if (myStat /= 0) call IO_error(100,trim(fileName)) allocate(character(len=fileLength)::fileContent) if (fileLength==0) then close(fileUnit) @@ -137,7 +137,7 @@ function IO_read(fileName) result(fileContent) endif read(fileUnit,iostat=myStat) fileContent - if (myStat /= 0) call IO_error(102,ext_msg=trim(fileName)) + if (myStat /= 0) call IO_error(102,trim(fileName)) close(fileUnit) if (scan(fileContent(:index(fileContent,LF)),CR//LF) /= 0) fileContent = CRLF2LF(fileContent) @@ -206,7 +206,7 @@ function IO_stringValue(string,chunkPos,myChunk) validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then IO_stringValue = '' - call IO_error(110,el=myChunk,ext_msg='IO_stringValue: "'//trim(string)//'"') + call IO_error(110,'IO_stringValue: "'//trim(string)//'"',label1='chunk',ID1=myChunk) else validChunk IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) endif validChunk @@ -303,10 +303,10 @@ integer function IO_stringAsInt(string) valid: if (verify(string,VALIDCHARS) == 0) then read(string,*,iostat=readStatus) IO_stringAsInt - if (readStatus /= 0) call IO_error(111,ext_msg=string) + if (readStatus /= 0) call IO_error(111,string) else valid IO_stringAsInt = 0 - call IO_error(111,ext_msg=string) + call IO_error(111,string) endif valid end function IO_stringAsInt @@ -325,10 +325,10 @@ real(pReal) function IO_stringAsFloat(string) valid: if (verify(string,VALIDCHARS) == 0) then read(string,*,iostat=readStatus) IO_stringAsFloat - if (readStatus /= 0) call IO_error(112,ext_msg=string) + if (readStatus /= 0) call IO_error(112,string) else valid IO_stringAsFloat = 0.0_pReal - call IO_error(112,ext_msg=string) + call IO_error(112,string) endif valid end function IO_stringAsFloat @@ -348,32 +348,30 @@ logical function IO_stringAsBool(string) IO_stringAsBool = .false. else IO_stringAsBool = .false. - call IO_error(113,ext_msg=string) + call IO_error(113,string) endif end function IO_stringAsBool !-------------------------------------------------------------------------------------------------- -!> @brief Write error statements to standard out and terminate the run with exit #9xxx +!> @brief Write error statements to standard out and terminate the run with exit #9xxx. !-------------------------------------------------------------------------------------------------- -subroutine IO_error(error_ID,el,ext_msg) +subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2) integer, intent(in) :: error_ID - integer, optional, intent(in) :: el - character(len=*), optional, intent(in) :: ext_msg + character(len=*), optional, intent(in) :: ext_msg,label1,label2 + integer, optional, intent(in) :: ID1,ID2 external :: quit character(len=:), allocatable :: msg character(len=pStringLen) :: formatString - select case (error_ID) + if (present(ID1) .and. .not. present(label1)) error stop 'error value without label (1)' + if (present(ID2) .and. .not. present(label2)) error stop 'error value without label (2)' -!-------------------------------------------------------------------------------------------------- -! internal errors - case (0) - msg = 'internal check failed:' + select case (error_ID) !-------------------------------------------------------------------------------------------------- ! file handling errors @@ -558,8 +556,16 @@ subroutine IO_error(error_ID,el,ext_msg) max(1,72-len_trim(ext_msg)-4),'x,a)' write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│' endif - if (present(el)) & - write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' + if (present(label1)) then + write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',& + max(1,72-len_trim(label1)-9-7),'x,a)' + write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│' + endif + if (present(label2)) then + write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',& + max(1,72-len_trim(label2)-9-7),'x,a)' + write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│' + endif write(IO_STDERR,'(a,69x,a)') ' │', '│' write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘' flush(IO_STDERR) diff --git a/src/Marc/discretization_Marc.f90 b/src/Marc/discretization_Marc.f90 index 10d7ca46a..8886e3ebb 100644 --- a/src/Marc/discretization_Marc.f90 +++ b/src/Marc/discretization_Marc.f90 @@ -80,13 +80,13 @@ subroutine discretization_Marc_init num_commercialFEM => config_numerics%get('commercialFEM',defaultVal = emptyDict) mesh_unitlength = num_commercialFEM%get_asFloat('unitlength',defaultVal=1.0_pReal) ! set physical extent of a length unit in mesh - if (mesh_unitlength <= 0.0_pReal) call IO_error(301,ext_msg='unitlength') + if (mesh_unitlength <= 0.0_pReal) call IO_error(301,'unitlength') call inputRead(elem,node0_elem,connectivity_elem,materialAt) nElems = size(connectivity_elem,2) - if (debug_e < 1 .or. debug_e > nElems) call IO_error(602,ext_msg='element') - if (debug_i < 1 .or. debug_i > elem%nIPs) call IO_error(602,ext_msg='IP') + if (debug_e < 1 .or. debug_e > nElems) call IO_error(602,'element') + if (debug_i < 1 .or. debug_i > elem%nIPs) call IO_error(602,'IP') allocate(cellNodeDefinition(elem%nNodes-1)) allocate(connectivity_cell(elem%NcellNodesPerCell,elem%nIPs,nElems)) @@ -579,7 +579,7 @@ subroutine inputRead_elemType(elem, & character(len=*), dimension(:), intent(in) :: fileContent !< file content, separated per lines integer, allocatable, dimension(:) :: chunkPos - integer :: i,j,t,l,remainingChunks + integer :: i,j,t,t_,l,remainingChunks t = -1 @@ -594,7 +594,8 @@ subroutine inputRead_elemType(elem, & t = mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2)) call elem%init(t) else - if (t /= mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2))) call IO_error(191,el=t) + t_ = mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2)) + if (t /= t_) call IO_error(191,IO_stringValue(fileContent(l+1+i+j),chunkPos,2),label1='type',ID1=t) endif remainingChunks = elem%nNodes - (chunkPos(1) - 2) do while(remainingChunks > 0) @@ -617,7 +618,7 @@ subroutine inputRead_elemType(elem, & character(len=*), intent(in) :: what - select case (IO_lc(what)) + select case (what) case ( '6') mapElemtype = 1 ! Two-dimensional Plane Strain Triangle case ( '125') ! 155, 128 (need test) @@ -645,7 +646,7 @@ subroutine inputRead_elemType(elem, & case ( '21') mapElemtype = 13 ! Three-dimensional Arbitrarily Distorted quadratic hexahedral case default - call IO_error(error_ID=190,ext_msg=IO_lc(what)) + call IO_error(190,what) end select end function mapElemtype diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 824d867c5..0d41338a1 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -290,7 +290,7 @@ program DAMASK_grid if (loadCases(l)%f_restart < huge(0)) & print'(2x,a,1x,i0)', 'f_restart:', loadCases(l)%f_restart - if (errorID > 0) call IO_error(error_ID = errorID, el = l) + if (errorID > 0) call IO_error(errorID,label1='line',ID1=l) endif reportAndCheck enddo diff --git a/src/lattice.f90 b/src/lattice.f90 index 1c1cdf67a..1496deb78 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -576,7 +576,7 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, & do i = 1,6 if (abs(C_target_unrotated66(i,i)) Date: Fri, 27 May 2022 00:14:00 +0200 Subject: [PATCH 18/99] bugfix: prevent segmentation fault need to rely on FFTWs calculation for amount of storage needed --- src/grid/spectral_utilities.f90 | 25 ++++++++++++++++--------- src/parallelization.f90 | 2 +- 2 files changed, 17 insertions(+), 10 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 9f3062d89..4e7bc2583 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -153,9 +153,8 @@ subroutine spectral_utilities_init() vectorField, & !< field containing data for FFTW in real space when debugging FFTW (no in place) scalarField !< field containing data for FFTW in real space when debugging FFTW (no in place) integer(C_INTPTR_T), dimension(3) :: cellsFFTW - integer(C_INTPTR_T) :: alloc_local, z, devNull + integer(C_INTPTR_T) :: N, z, devNull integer(C_INTPTR_T), parameter :: & - scalarSize = 1_C_INTPTR_T, & vectorSize = 3_C_INTPTR_T, & tensorSize = 9_C_INTPTR_T character(len=*), parameter :: & @@ -261,26 +260,34 @@ subroutine spectral_utilities_init() print'(/,1x,a)', 'FFTW initialized'; flush(IO_STDOUT) !-------------------------------------------------------------------------------------------------- -! MPI allocation - cellsFFTW = int(cells,C_INTPTR_T) - alloc_local = fftw_mpi_local_size_3d(cellsFFTW(3), cellsFFTW(2), cellsFFTW(1)/2 +1, & - PETSC_COMM_WORLD, z, devNull) +! allocation allocate (xi1st (3,cells1Red,cells(2),cells3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for first derivatives, only half the size for first dimension allocate (xi2nd (3,cells1Red,cells(2),cells3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for second derivatives, only half the size for first dimension - tensorField = fftw_alloc_complex(tensorSize*alloc_local) + cellsFFTW = int(cells,C_INTPTR_T) + + N = fftw_mpi_local_size_many(3,[cellsFFTW(3),cellsFFTW(2),cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T],& + tensorSize,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD,z,devNull) + if (z /= cells3) error stop 'domain decomposition mismatch (tensor)' + tensorField = fftw_alloc_complex(N) call c_f_pointer(tensorField,tensorField_real, & [3_C_INTPTR_T,3_C_INTPTR_T,2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) call c_f_pointer(tensorField,tensorField_fourier, & [3_C_INTPTR_T,3_C_INTPTR_T, cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T, cellsFFTW(2),z]) - vectorField = fftw_alloc_complex(vectorSize*alloc_local) + N = fftw_mpi_local_size_many(3,[cellsFFTW(3),cellsFFTW(2),cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T],& + vectorSize,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD,z,devNull) + if (z /= cells3) error stop 'domain decomposition mismatch (vector)' + vectorField = fftw_alloc_complex(N) call c_f_pointer(vectorField,vectorField_real, & [3_C_INTPTR_T,2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) call c_f_pointer(vectorField,vectorField_fourier, & [3_C_INTPTR_T, cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T, cellsFFTW(2),z]) - scalarField = fftw_alloc_complex(scalarSize*alloc_local) + N = fftw_mpi_local_size_3d(cellsFFTW(3),cellsFFTW(2),cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T,& + PETSC_COMM_WORLD,z,devNull) + if (z /= cells3) error stop 'domain decomposition mismatch (scalar)' + scalarField = fftw_alloc_complex(N) call c_f_pointer(scalarField,scalarField_real, & [2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) call c_f_pointer(scalarField,scalarField_fourier, & diff --git a/src/parallelization.f90 b/src/parallelization.f90 index 8cc6d3abb..44e5c86ae 100644 --- a/src/parallelization.f90 +++ b/src/parallelization.f90 @@ -90,7 +90,7 @@ subroutine parallelization_init #ifdef LOGFILE write(rank_str,'(i4.4)') worldrank open(OUTPUT_UNIT,file='out.'//rank_str,status='replace',encoding='UTF-8') - open(ERROR_UNIT,file='error.'//rank_str,status='replace',encoding='UTF-8') + open(ERROR_UNIT,file='err.'//rank_str,status='replace',encoding='UTF-8') #else if (worldrank /= 0) then close(OUTPUT_UNIT) ! disable output From dc59beb59c30c225804d2f0b49ff1b2951cec8af Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 07:03:06 +0200 Subject: [PATCH 19/99] following advince from FFTW3 manual silences a lot of gfortran warnings about unused variables --- src/grid/FFTW.f90 | 13 +++++++++++++ src/grid/discretization_grid.f90 | 2 +- src/grid/spectral_utilities.f90 | 5 +---- 3 files changed, 15 insertions(+), 5 deletions(-) create mode 100644 src/grid/FFTW.f90 diff --git a/src/grid/FFTW.f90 b/src/grid/FFTW.f90 new file mode 100644 index 000000000..e552e78e0 --- /dev/null +++ b/src/grid/FFTW.f90 @@ -0,0 +1,13 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, KU Leuven +!> @brief Wrap FFTW3 into a module. +!-------------------------------------------------------------------------------------------------- +module FFTW3 + use, intrinsic :: ISO_C_binding + + implicit none + public + + include 'fftw3-mpi.f03' + +end module FFTW3 diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 901d35a9a..916cf6e69 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -10,6 +10,7 @@ module discretization_grid #if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) use MPI_f08 #endif + use FFTW3 use prec use parallelization @@ -50,7 +51,6 @@ subroutine discretization_grid_init(restart) logical, intent(in) :: restart - include 'fftw3-mpi.f03' real(pReal), dimension(3) :: & mySize, & !< domain size of this process origin !< (global) distance to origin diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 4e7bc2583..c047d8669 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -4,13 +4,12 @@ !> @brief Utilities used by the different spectral solver variants !-------------------------------------------------------------------------------------------------- module spectral_utilities - use, intrinsic :: iso_c_binding - #include use PETScSys #if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) use MPI_f08 #endif + use FFTW3 use prec use CLI @@ -26,8 +25,6 @@ module spectral_utilities implicit none private - include 'fftw3-mpi.f03' - !-------------------------------------------------------------------------------------------------- ! grid related information real(pReal), protected, public :: wgt !< weighting factor 1/Nelems From d66c777d6e45d6608f67fab603f52633493ff48a Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 27 May 2022 11:37:00 -0400 Subject: [PATCH 20/99] introduced "IO_panel" to write statements to STDERR --- src/IO.f90 | 158 ++++++++++++++++++++++++++--------------------------- 1 file changed, 76 insertions(+), 82 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 01fca31bd..4c6c53848 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -15,6 +15,7 @@ module IO implicit none private + integer, parameter :: IO_panelwidth = 69 character(len=*), parameter, public :: & IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13), & !< whitespace characters IO_QUOTES = "'"//'"' @@ -25,10 +26,7 @@ module IO CR = achar(13), & LF = IO_EOL character(len=*), parameter :: & - DIVIDER = '───────────────────'//& - '───────────────────'//& - '───────────────────'//& - '────────────' + DIVIDER = repeat('─',IO_panelwidth) public :: & IO_init, & @@ -57,7 +55,6 @@ contains subroutine IO_init print'(/,1x,a)', '<<<+- IO init -+>>>'; flush(IO_STDOUT) - call selfTest end subroutine IO_init @@ -355,7 +352,58 @@ end function IO_stringAsBool !-------------------------------------------------------------------------------------------------- -!> @brief Write error statements to standard out and terminate the run with exit #9xxx. +!> @brief Write statements to standard error. +!-------------------------------------------------------------------------------------------------- +subroutine IO_panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2) + + character(len=*), intent(in) :: paneltype,msg + character(len=*), optional, intent(in) :: ext_msg,label1,label2 + integer, intent(in) :: ID + integer, optional, intent(in) :: ID1,ID2 + + character(len=pStringLen) :: formatString + + + if (.not. present(label1) .and. present(ID1)) error stop 'missing label for value 1' + if (.not. present(label2) .and. present(ID2)) error stop 'missing label for value 2' + if ( present(label1) .and. .not. present(ID1)) error stop 'missing value for label 1' + if ( present(label2) .and. .not. present(ID2)) error stop 'missing value for label 2' + + !$OMP CRITICAL (write2out) + write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐' + write(formatString,'(a,i2,a)') '(a,24x,a,',max(1,IO_panelwidth-24-len_trim(paneltype)),'x,a)' + write(IO_STDERR,formatString) ' │',trim(paneltype), '│' + write(formatString,'(a,i2,a)') '(a,24x,i3,',max(1,IO_panelwidth-24-3),'x,a)' + write(IO_STDERR,formatString) ' │',ID, '│' + write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤' + write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(msg)),',',& + max(1,IO_panelwidth+3-len_trim(msg)-4),'x,a)' + write(IO_STDERR,formatString) '│ ',trim(msg), '│' + if (present(ext_msg)) then + write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',& + max(1,IO_panelwidth+3-len_trim(ext_msg)-4),'x,a)' + write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│' + endif + if (present(label1)) then + write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',& + max(1,IO_panelwidth+3-len_trim(label1)-9-7),'x,a)' + write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│' + endif + if (present(label2)) then + write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',& + max(1,IO_panelwidth+3-len_trim(label2)-9-7),'x,a)' + write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│' + endif + write(formatString,'(a,i2.2,a)') '(a,',max(1,IO_panelwidth),'x,a)' + write(IO_STDERR,formatString) ' │', '│' + write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘' + flush(IO_STDERR) + !$OMP END CRITICAL (write2out) + +end subroutine IO_panel + +!-------------------------------------------------------------------------------------------------- +!> @brief Write error statements and terminate the run with exit #9xxx. !-------------------------------------------------------------------------------------------------- subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2) @@ -365,11 +413,6 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2) external :: quit character(len=:), allocatable :: msg - character(len=pStringLen) :: formatString - - - if (present(ID1) .and. .not. present(label1)) error stop 'error value without label (1)' - if (present(ID2) .and. .not. present(label2)) error stop 'error value without label (2)' select case (error_ID) @@ -444,7 +487,7 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2) case (190) msg = 'unknown element type:' case (191) - msg = 'mesh consists of more than one element type' + msg = 'mesh contains more than one element type' !-------------------------------------------------------------------------------------------------- ! plasticity error messages @@ -481,27 +524,27 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2) !------------------------------------------------------------------------------------------------ ! errors related to YAML data case (701) - msg = 'Incorrect indent/Null value not allowed' + msg = 'incorrect indent/Null value not allowed' case (702) - msg = 'Invalid use of flow YAML' + msg = 'invalid use of flow YAML' case (703) - msg = 'Invalid YAML' + msg = 'invalid YAML' case (704) - msg = 'Space expected after a colon for : pair' + msg = 'space expected after a colon for : pair' case (705) - msg = 'Unsupported feature' + msg = 'unsupported feature' case (706) - msg = 'Type mismatch in YAML data node' + msg = 'type mismatch in YAML data node' case (707) - msg = 'Abrupt end of file' + msg = 'abrupt end of file' case (708) - msg = '--- expected after YAML file header' + msg = '"---" expected after YAML file header' case (709) - msg = 'Length mismatch' + msg = 'length mismatch' case (710) - msg = 'Closing quotation mark missing in string' + msg = 'closing quotation mark missing in string' case (711) - msg = 'Incorrect type' + msg = 'incorrect type' !------------------------------------------------------------------------------------------------- ! errors related to the mesh solver @@ -543,40 +586,17 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2) end select - !$OMP CRITICAL (write2out) - write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐' - write(IO_STDERR,'(a,24x,a,40x,a)') ' │','error', '│' - write(IO_STDERR,'(a,24x,i3,42x,a)') ' │',error_ID, '│' - write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤' - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',& - max(1,72-len_trim(msg)-4),'x,a)' - write(IO_STDERR,formatString) '│ ',trim(msg), '│' - if (present(ext_msg)) then - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',& - max(1,72-len_trim(ext_msg)-4),'x,a)' - write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│' - endif - if (present(label1)) then - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',& - max(1,72-len_trim(label1)-9-7),'x,a)' - write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│' - endif - if (present(label2)) then - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',& - max(1,72-len_trim(label2)-9-7),'x,a)' - write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│' - endif - write(IO_STDERR,'(a,69x,a)') ' │', '│' - write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘' - flush(IO_STDERR) + call IO_panel('error',error_ID,msg, & + ext_msg=ext_msg, & + label1=label1,ID1=ID1, & + label2=label2,ID2=ID2) call quit(9000+error_ID) - !$OMP END CRITICAL (write2out) end subroutine IO_error !-------------------------------------------------------------------------------------------------- -!> @brief Write warning statement to standard out. +!> @brief Write warning statements. !-------------------------------------------------------------------------------------------------- subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2) @@ -585,12 +605,8 @@ subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2) integer, optional, intent(in) :: ID1,ID2 character(len=:), allocatable :: msg - character(len=pStringLen) :: formatString - if (present(ID1) .and. .not. present(label1)) error stop 'warning value without label (1)' - if (present(ID2) .and. .not. present(label2)) error stop 'warning value without label (2)' - select case (warning_ID) case (47) msg = 'invalid parameter for FFTW, using FFTW_PATIENT' @@ -602,37 +618,15 @@ subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2) msg = 'stiffness close to zero' case (709) msg = 'read only the first document' + case default error stop 'invalid warning number' end select - !$OMP CRITICAL (write2out) - write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐' - write(IO_STDERR,'(a,24x,a,38x,a)') ' │','warning', '│' - write(IO_STDERR,'(a,24x,i3,42x,a)') ' │',warning_ID, '│' - write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤' - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',& - max(1,72-len_trim(msg)-4),'x,a)' - write(IO_STDERR,formatString) '│ ',trim(msg), '│' - if (present(ext_msg)) then - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',& - max(1,72-len_trim(ext_msg)-4),'x,a)' - write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│' - endif - if (present(label1)) then - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',& - max(1,72-len_trim(label1)-9-7),'x,a)' - write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│' - endif - if (present(label2)) then - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',& - max(1,72-len_trim(label2)-9-7),'x,a)' - write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│' - endif - write(IO_STDERR,'(a,69x,a)') ' │', '│' - write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘' - flush(IO_STDERR) - !$OMP END CRITICAL (write2out) + call IO_panel('warning',warning_ID,msg, & + ext_msg=ext_msg, & + label1=label1,ID1=ID1, & + label2=label2,ID2=ID2) end subroutine IO_warning From 75bd64325884a62d0384cf11e71bea5528d2572f Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 27 May 2022 11:58:10 -0400 Subject: [PATCH 21/99] more precise warning for fftw_plan_mode --- src/IO.f90 | 2 +- src/grid/spectral_utilities.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 4c6c53848..bbc6fe130 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -609,7 +609,7 @@ subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2) select case (warning_ID) case (47) - msg = 'invalid parameter for FFTW, using FFTW_PATIENT' + msg = 'invalid parameter for FFTW' case (207) msg = 'line truncated' case (600) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 0c114f8cb..9752fe046 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -249,7 +249,7 @@ subroutine spectral_utilities_init() case('fftw_exhaustive') FFTW_planner_flag = FFTW_EXHAUSTIVE case default - call IO_warning(47,trim(num_grid%get_asString('fftw_plan_mode'))) + call IO_warning(47,trim(num_grid%get_asString('fftw_plan_mode')),ext_msg='using default FFTW_MEASURE') FFTW_planner_flag = FFTW_MEASURE end select From f85e8a3ff45c6c2919ddb94e33ea6d721d76448b Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 27 May 2022 12:00:53 -0400 Subject: [PATCH 22/99] more precise warning for fftw_plan_mode --- src/grid/spectral_utilities.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 9752fe046..82f7938a2 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -249,7 +249,7 @@ subroutine spectral_utilities_init() case('fftw_exhaustive') FFTW_planner_flag = FFTW_EXHAUSTIVE case default - call IO_warning(47,trim(num_grid%get_asString('fftw_plan_mode')),ext_msg='using default FFTW_MEASURE') + call IO_warning(47,'using default FFTW_MEASURE instead of "'//trim(num_grid%get_asString('fftw_plan_mode'))//'"') FFTW_planner_flag = FFTW_MEASURE end select From b56ded62d9403abea0f27050c7b21346e0fd7951 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 17:57:16 +0200 Subject: [PATCH 23/99] encapsulate data, prefix only public functions --- src/IO.f90 | 118 +++++++++++++++++++++++++++-------------------------- 1 file changed, 60 insertions(+), 58 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index bbc6fe130..a6ecb1491 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -15,7 +15,6 @@ module IO implicit none private - integer, parameter :: IO_panelwidth = 69 character(len=*), parameter, public :: & IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13), & !< whitespace characters IO_QUOTES = "'"//'"' @@ -25,8 +24,6 @@ module IO character, parameter :: & CR = achar(13), & LF = IO_EOL - character(len=*), parameter :: & - DIVIDER = repeat('─',IO_panelwidth) public :: & IO_init, & @@ -52,10 +49,11 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief Do self test. !-------------------------------------------------------------------------------------------------- -subroutine IO_init +subroutine IO_init() print'(/,1x,a)', '<<<+- IO init -+>>>'; flush(IO_STDOUT) - call selfTest + + call selfTest() end subroutine IO_init @@ -351,56 +349,6 @@ logical function IO_stringAsBool(string) end function IO_stringAsBool -!-------------------------------------------------------------------------------------------------- -!> @brief Write statements to standard error. -!-------------------------------------------------------------------------------------------------- -subroutine IO_panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2) - - character(len=*), intent(in) :: paneltype,msg - character(len=*), optional, intent(in) :: ext_msg,label1,label2 - integer, intent(in) :: ID - integer, optional, intent(in) :: ID1,ID2 - - character(len=pStringLen) :: formatString - - - if (.not. present(label1) .and. present(ID1)) error stop 'missing label for value 1' - if (.not. present(label2) .and. present(ID2)) error stop 'missing label for value 2' - if ( present(label1) .and. .not. present(ID1)) error stop 'missing value for label 1' - if ( present(label2) .and. .not. present(ID2)) error stop 'missing value for label 2' - - !$OMP CRITICAL (write2out) - write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐' - write(formatString,'(a,i2,a)') '(a,24x,a,',max(1,IO_panelwidth-24-len_trim(paneltype)),'x,a)' - write(IO_STDERR,formatString) ' │',trim(paneltype), '│' - write(formatString,'(a,i2,a)') '(a,24x,i3,',max(1,IO_panelwidth-24-3),'x,a)' - write(IO_STDERR,formatString) ' │',ID, '│' - write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤' - write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(msg)),',',& - max(1,IO_panelwidth+3-len_trim(msg)-4),'x,a)' - write(IO_STDERR,formatString) '│ ',trim(msg), '│' - if (present(ext_msg)) then - write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',& - max(1,IO_panelwidth+3-len_trim(ext_msg)-4),'x,a)' - write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│' - endif - if (present(label1)) then - write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',& - max(1,IO_panelwidth+3-len_trim(label1)-9-7),'x,a)' - write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│' - endif - if (present(label2)) then - write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',& - max(1,IO_panelwidth+3-len_trim(label2)-9-7),'x,a)' - write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│' - endif - write(formatString,'(a,i2.2,a)') '(a,',max(1,IO_panelwidth),'x,a)' - write(IO_STDERR,formatString) ' │', '│' - write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘' - flush(IO_STDERR) - !$OMP END CRITICAL (write2out) - -end subroutine IO_panel !-------------------------------------------------------------------------------------------------- !> @brief Write error statements and terminate the run with exit #9xxx. @@ -586,7 +534,7 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2) end select - call IO_panel('error',error_ID,msg, & + call panel('error',error_ID,msg, & ext_msg=ext_msg, & label1=label1,ID1=ID1, & label2=label2,ID2=ID2) @@ -623,7 +571,7 @@ subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2) error stop 'invalid warning number' end select - call IO_panel('warning',warning_ID,msg, & + call panel('warning',warning_ID,msg, & ext_msg=ext_msg, & label1=label1,ID1=ID1, & label2=label2,ID2=ID2) @@ -654,7 +602,61 @@ pure function CRLF2LF(string) CRLF2LF = CRLF2LF(:c-n) -end function +end function CRLF2LF + + +!-------------------------------------------------------------------------------------------------- +!> @brief Write statements to standard error. +!-------------------------------------------------------------------------------------------------- +subroutine panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2) + + character(len=*), intent(in) :: paneltype,msg + character(len=*), optional, intent(in) :: ext_msg,label1,label2 + integer, intent(in) :: ID + integer, optional, intent(in) :: ID1,ID2 + + character(len=pStringLen) :: formatString + integer, parameter :: panelwidth = 69 + character(len=*), parameter :: DIVIDER = repeat('─',panelwidth) + + + if (.not. present(label1) .and. present(ID1)) error stop 'missing label for value 1' + if (.not. present(label2) .and. present(ID2)) error stop 'missing label for value 2' + if ( present(label1) .and. .not. present(ID1)) error stop 'missing value for label 1' + if ( present(label2) .and. .not. present(ID2)) error stop 'missing value for label 2' + + !$OMP CRITICAL (write2out) + write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐' + write(formatString,'(a,i2,a)') '(a,24x,a,',max(1,panelwidth-24-len_trim(paneltype)),'x,a)' + write(IO_STDERR,formatString) ' │',trim(paneltype), '│' + write(formatString,'(a,i2,a)') '(a,24x,i3,',max(1,panelwidth-24-3),'x,a)' + write(IO_STDERR,formatString) ' │',ID, '│' + write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤' + write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(msg)),',',& + max(1,panelwidth+3-len_trim(msg)-4),'x,a)' + write(IO_STDERR,formatString) '│ ',trim(msg), '│' + if (present(ext_msg)) then + write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',& + max(1,panelwidth+3-len_trim(ext_msg)-4),'x,a)' + write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│' + endif + if (present(label1)) then + write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',& + max(1,panelwidth+3-len_trim(label1)-9-7),'x,a)' + write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│' + endif + if (present(label2)) then + write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',& + max(1,panelwidth+3-len_trim(label2)-9-7),'x,a)' + write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│' + endif + write(formatString,'(a,i2.2,a)') '(a,',max(1,panelwidth),'x,a)' + write(IO_STDERR,formatString) ' │', '│' + write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘' + flush(IO_STDERR) + !$OMP END CRITICAL (write2out) + +end subroutine panel !-------------------------------------------------------------------------------------------------- From 2bfcc4d0b8f1c70b2bc333cff2749f1a59587812 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 20:53:16 +0200 Subject: [PATCH 24/99] standardized reporting --- src/phase_mechanical_plastic_isotropic.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/phase_mechanical_plastic_isotropic.f90 b/src/phase_mechanical_plastic_isotropic.f90 index 49efc9fae..bde6f0892 100644 --- a/src/phase_mechanical_plastic_isotropic.f90 +++ b/src/phase_mechanical_plastic_isotropic.f90 @@ -69,8 +69,8 @@ module function plastic_isotropic_init() result(myPlasticity) print'(/,1x,a)', '<<<+- phase:mechanical:plastic:isotropic init -+>>>' print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT) - print'(/,a)', 'T. Maiti and P. Eisenlohr, Scripta Materialia 145:37–40, 2018' - print'(/,a)', 'https://doi.org/10.1016/j.scriptamat.2017.09.047' + print'(/,1x,a)', 'T. Maiti and P. Eisenlohr, Scripta Materialia 145:37–40, 2018' + print'( 1x,a)', 'https://doi.org/10.1016/j.scriptamat.2017.09.047' phases => config_material%get('phase') allocate(param(phases%length)) From 6fa87b4038ae541fd00fefb98defb56cdff9fb5c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 20:58:18 +0200 Subject: [PATCH 25/99] not needed anymore --- src/phase_damage.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/phase_damage.f90 b/src/phase_damage.f90 index 5bf351dd0..82d94150d 100644 --- a/src/phase_damage.f90 +++ b/src/phase_damage.f90 @@ -383,9 +383,9 @@ module function phase_K_phi(co,ce) result(K) integer, intent(in) :: co, ce real(pReal), dimension(3,3) :: K - real(pReal), parameter :: l = 1.0_pReal - K = crystallite_push33ToRef(co,ce,param(material_phaseID(co,ce))%D) * l**2 + + K = crystallite_push33ToRef(co,ce,param(material_phaseID(co,ce))%D) end function phase_K_phi @@ -401,6 +401,7 @@ function phase_damage_deltaState(Fe, ph, en) result(broken) en real(pReal), intent(in), dimension(3,3) :: & Fe !< elastic deformation gradient + integer :: & myOffset, & mySize From d858d753e3b9773498d1c57ab2cb2ee3f581a4e1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 22:34:33 +0200 Subject: [PATCH 26/99] implicit none does not propagate each subroutine/function is independent and not part of a scope --- src/LAPACK_interface.f90 | 10 ++++++++++ src/YAML_parse.f90 | 1 + src/grid/zlib.f90 | 16 ++++++++-------- src/system_routines.f90 | 15 ++++++++++++--- 4 files changed, 31 insertions(+), 11 deletions(-) diff --git a/src/LAPACK_interface.f90 b/src/LAPACK_interface.f90 index e11f74875..43ddb5771 100644 --- a/src/LAPACK_interface.f90 +++ b/src/LAPACK_interface.f90 @@ -8,6 +8,8 @@ module LAPACK_interface pure subroutine dgeev(jobvl,jobvr,n,a,lda,wr,wi,vl,ldvl,vr,ldvr,work,lwork,info) use prec + implicit none + character, intent(in) :: jobvl,jobvr integer, intent(in) :: n,lda,ldvl,ldvr,lwork real(pReal), intent(inout), dimension(lda,n) :: a @@ -20,6 +22,8 @@ module LAPACK_interface pure subroutine dgesv(n,nrhs,a,lda,ipiv,b,ldb,info) use prec + implicit none + integer, intent(in) :: n,nrhs,lda,ldb real(pReal), intent(inout), dimension(lda,n) :: a integer, intent(out), dimension(n) :: ipiv @@ -29,6 +33,8 @@ module LAPACK_interface pure subroutine dgetrf(m,n,a,lda,ipiv,info) use prec + implicit none + integer, intent(in) :: m,n,lda real(pReal), intent(inout), dimension(lda,n) :: a integer, intent(out), dimension(min(m,n)) :: ipiv @@ -37,6 +43,8 @@ module LAPACK_interface pure subroutine dgetri(n,a,lda,ipiv,work,lwork,info) use prec + implicit none + integer, intent(in) :: n,lda,lwork real(pReal), intent(inout), dimension(lda,n) :: a integer, intent(in), dimension(n) :: ipiv @@ -46,6 +54,8 @@ module LAPACK_interface pure subroutine dsyev(jobz,uplo,n,a,lda,w,work,lwork,info) use prec + implicit none + character, intent(in) :: jobz,uplo integer, intent(in) :: n,lda,lwork real(pReal), intent(inout), dimension(lda,n) :: a diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90 index bfce06bc9..a887476a9 100644 --- a/src/YAML_parse.f90 +++ b/src/YAML_parse.f90 @@ -24,6 +24,7 @@ module YAML_parse subroutine to_flow_C(flow,length_flow,mixed) bind(C) use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR, C_PTR + implicit none type(C_PTR), intent(out) :: flow integer(C_INT), intent(out) :: length_flow diff --git a/src/grid/zlib.f90 b/src/grid/zlib.f90 index 21428255c..10a62a55b 100644 --- a/src/grid/zlib.f90 +++ b/src/grid/zlib.f90 @@ -13,15 +13,14 @@ module zlib interface - subroutine inflate_C(s_deflated,s_inflated,deflated,inflated) bind(C) - use, intrinsic :: ISO_C_Binding, only: & - C_SIGNED_CHAR, C_INT64_T + subroutine inflate_C(s_deflated,s_inflated,deflated,inflated) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_SIGNED_CHAR, C_INT64_T + implicit none - integer(C_INT64_T), intent(in) :: s_deflated,s_inflated - integer(C_SIGNED_CHAR), dimension(s_deflated), intent(in) :: deflated - integer(C_SIGNED_CHAR), dimension(s_inflated), intent(out) :: inflated - - end subroutine inflate_C + integer(C_INT64_T), intent(in) :: s_deflated,s_inflated + integer(C_SIGNED_CHAR), dimension(s_deflated), intent(in) :: deflated + integer(C_SIGNED_CHAR), dimension(s_inflated), intent(out) :: inflated + end subroutine inflate_C end interface @@ -37,6 +36,7 @@ function zlib_inflate(deflated,size_inflated) integer(C_SIGNED_CHAR), dimension(size_inflated) :: zlib_inflate + call inflate_C(size(deflated,kind=C_INT64_T),int(size_inflated,C_INT64_T),deflated,zlib_inflate) end function zlib_inflate diff --git a/src/system_routines.f90 b/src/system_routines.f90 index 2af1e12a9..209013be4 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -24,8 +24,10 @@ module system_routines interface + function setCWD_C(cwd) bind(C) use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR + implicit none integer(C_INT) :: setCWD_C character(kind=C_CHAR), dimension(*), intent(in) :: cwd @@ -34,6 +36,7 @@ module system_routines subroutine getCWD_C(cwd, stat) bind(C) use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR use prec + implicit none character(kind=C_CHAR), dimension(pPathLen+1), intent(out) :: cwd ! NULL-terminated array integer(C_INT), intent(out) :: stat @@ -42,6 +45,7 @@ module system_routines subroutine getHostName_C(hostname, stat) bind(C) use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR use prec + implicit none character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: hostname ! NULL-terminated array integer(C_INT), intent(out) :: stat @@ -50,6 +54,7 @@ module system_routines subroutine getUserName_C(username, stat) bind(C) use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR use prec + implicit none character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: username ! NULL-terminated array integer(C_INT), intent(out) :: stat @@ -57,27 +62,31 @@ module system_routines subroutine signalint_C(handler) bind(C) use, intrinsic :: ISO_C_Binding, only: C_FUNPTR + implicit none type(C_FUNPTR), intent(in), value :: handler end subroutine signalint_C subroutine signalusr1_C(handler) bind(C) use, intrinsic :: ISO_C_Binding, only: C_FUNPTR + implicit none type(C_FUNPTR), intent(in), value :: handler end subroutine signalusr1_C subroutine signalusr2_C(handler) bind(C) use, intrinsic :: ISO_C_Binding, only: C_FUNPTR + implicit none type(C_FUNPTR), intent(in), value :: handler end subroutine signalusr2_C subroutine free_C(ptr) bind(C,name='free') - import c_ptr - type(c_ptr), value :: ptr - end subroutine free_C + use, intrinsic :: ISO_C_Binding, only: C_PTR + implicit none + type(C_PTR), value :: ptr + end subroutine free_C end interface From e163d247ec9455a87a03def99dcd5e25bdefc376 Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 28 May 2022 04:22:27 +0200 Subject: [PATCH 27/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-402-g2bfcc4d0b --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 181f57ab6..86d484787 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-400-g1dc5e353c +3.0.0-alpha6-402-g2bfcc4d0b From 614eaa0032fd000d515422361b1b88f9e6d0db17 Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 28 May 2022 21:16:36 +0200 Subject: [PATCH 28/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-419-g3d10d2925 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 86d484787..8ade4e23f 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-402-g2bfcc4d0b +3.0.0-alpha6-419-g3d10d2925 From 508680629ea18c2af501962799ccb3ee306a1b33 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 31 May 2022 16:31:18 +0200 Subject: [PATCH 29/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-422-gb8530bbcc --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 8ade4e23f..14284d5a5 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-419-g3d10d2925 +3.0.0-alpha6-422-gb8530bbcc From b9214fcc6cb9b9534337b359408ae3528643ecb6 Mon Sep 17 00:00:00 2001 From: "d.mentock" Date: Thu, 2 Jun 2022 19:40:18 +0200 Subject: [PATCH 30/99] Prevent windows overflow error when using numpy dtype=int instead of int64 --- python/damask/_colormap.py | 2 +- python/damask/_grid.py | 14 +++++++------- python/damask/_table.py | 6 +++--- python/damask/_vtk.py | 2 +- python/damask/seeds.py | 2 +- python/damask/util.py | 2 +- 6 files changed, 14 insertions(+), 14 deletions(-) diff --git a/python/damask/_colormap.py b/python/damask/_colormap.py index 5253e0acb..1d3ab74ec 100644 --- a/python/damask/_colormap.py +++ b/python/damask/_colormap.py @@ -385,7 +385,7 @@ class Colormap(mpl.colors.ListedColormap): GOM_str = '1 1 {name} 9 {name} '.format(name=self.name.replace(" ","_")) \ + '0 1 0 3 0 0 -1 9 \\ 0 0 0 255 255 255 0 0 255 ' \ + f'30 NO_UNIT 1 1 64 64 64 255 1 0 0 0 0 0 0 3 0 {self.N}' \ - + ' '.join([f' 0 {c[0]} {c[1]} {c[2]} 255 1' for c in reversed((self.colors*255).astype(int))]) \ + + ' '.join([f' 0 {c[0]} {c[1]} {c[2]} 255 1' for c in reversed((self.colors*255).astype(np.int64))]) \ + '\n' self._get_file_handle(fname,'.legend').write(GOM_str) diff --git a/python/damask/_grid.py b/python/damask/_grid.py index 4e82a4180..44126519c 100644 --- a/python/damask/_grid.py +++ b/python/damask/_grid.py @@ -117,8 +117,8 @@ class Grid: self._material = np.copy(material) if self.material.dtype in np.sctypes['float'] and \ - np.all(self.material == self.material.astype(int).astype(float)): - self._material = self.material.astype(int) + np.all(self.material == self.material.astype(np.int64).astype(float)): + self._material = self.material.astype(np.int64) @property @@ -285,7 +285,7 @@ class Grid: raise TypeError(f'mismatch between {cells.prod()} expected entries and {i} found') if not np.any(np.mod(material,1) != 0.0): # no float present - material = material.astype(int) - (1 if material.min() > 0 else 0) + material = material.astype(np.int64) - (1 if material.min() > 0 else 0) return Grid(material = material.reshape(cells,order='F'), size = size, @@ -916,7 +916,7 @@ class Grid: cval=np.nanmax(self.material) + 1 if fill is None else fill) # avoid scipy interpolation errors for rotations close to multiples of 90° material = material_temp if np.prod(material_temp.shape) != np.prod(material.shape) else \ - np.rot90(material,k=np.rint(angle/90.).astype(int),axes=axes) + np.rot90(material,k=np.rint(angle/90.).astype(np.int64),axes=axes) origin = self.origin-(np.asarray(material.shape)-self.cells)*.5 * self.size/self.cells @@ -1094,7 +1094,7 @@ class Grid: rng = np.random.default_rng(rng_seed) - d = np.floor(distance).astype(int) + d = np.floor(distance).astype(np.int64) ext = np.linspace(-d,d,1+2*d,dtype=float), xx,yy,zz = np.meshgrid(ext,ext,ext) footprint = xx**2+yy**2+zz**2 <= distance**2+distance*1e-8 @@ -1197,7 +1197,7 @@ class Grid: mask = np.sum(np.power(coords_rot/r,2.0**np.array(exponent)),axis=-1) > 1.0 if periodic: # translate back to center - mask = np.roll(mask,((c/self.size-0.5)*self.cells).round().astype(int),(0,1,2)) + mask = np.roll(mask,((c/self.size-0.5)*self.cells).round().astype(np.int64),(0,1,2)) return Grid(material = np.where(np.logical_not(mask) if inverse else mask, self.material, @@ -1249,7 +1249,7 @@ class Grid: return np.any(stencil != me if selection is None else np.in1d(stencil,np.array(list(selection - {me})))) - d = np.floor(distance).astype(int) + d = np.floor(distance).astype(np.int64) ext = np.linspace(-d,d,1+2*d,dtype=float), xx,yy,zz = np.meshgrid(ext,ext,ext) footprint = xx**2+yy**2+zz**2 <= distance**2+distance*1e-8 diff --git a/python/damask/_table.py b/python/damask/_table.py index 1219cbc78..f5c6f61e2 100644 --- a/python/damask/_table.py +++ b/python/damask/_table.py @@ -134,7 +134,7 @@ class Table: labels = [] for label in what: shape = self.shapes[label] - size = np.prod(shape,dtype=int) + size = np.prod(shape,dtype=np.int64) if how == 'uniform': labels += [label] * size elif how == 'shapes': @@ -168,7 +168,7 @@ class Table: shape: Tuple[int, ...], info: str = None): if info is not None: - specific = f'{label}{" "+str(shape) if np.prod(shape,dtype=int) > 1 else ""}: {info}' + specific = f'{label}{" "+str(shape) if np.prod(shape,dtype=np.int64) > 1 else ""}: {info}' general = util.execution_stamp('Table') self.comments.append(f'{specific} / {general}') @@ -401,7 +401,7 @@ class Table: else: dup.shapes[label] = data.shape[1:] if len(data.shape) > 1 else (1,) - size = np.prod(data.shape[1:],dtype=int) + size = np.prod(data.shape[1:],dtype=np.int64) new = pd.DataFrame(data=data.reshape(-1,size), columns=[label]*size, ) diff --git a/python/damask/_vtk.py b/python/damask/_vtk.py index c41470638..1b7bba2fa 100644 --- a/python/damask/_vtk.py +++ b/python/damask/_vtk.py @@ -187,7 +187,7 @@ class VTK: ---------- nodes : numpy.ndarray, shape (:,3) Spatial position of the nodes. - connectivity : numpy.ndarray of np.dtype = int + connectivity : numpy.ndarray of np.dtype = np.int64 Cell connectivity (0-based), first dimension determines #Cells, second dimension determines #Nodes/Cell. cell_type : str diff --git a/python/damask/seeds.py b/python/damask/seeds.py index a4ddfb418..11be5cc93 100644 --- a/python/damask/seeds.py +++ b/python/damask/seeds.py @@ -45,7 +45,7 @@ def from_random(size: _FloatSequence, else: grid_coords = _grid_filters.coordinates0_point(cells,size).reshape(-1,3,order='F') coords = grid_coords[rng.choice(_np.prod(cells),N_seeds, replace=False)] \ - + _np.broadcast_to(size_/_np.array(cells,int),(N_seeds,3))*(rng.random((N_seeds,3))*.5-.25) # wobble w/o leaving grid + + _np.broadcast_to(size_/_np.array(cells,_np.int64),(N_seeds,3))*(rng.random((N_seeds,3))*.5-.25) # wobble w/o leaving grid return coords diff --git a/python/damask/util.py b/python/damask/util.py index 1ab58e8b6..ab3789bf5 100644 --- a/python/damask/util.py +++ b/python/damask/util.py @@ -314,7 +314,7 @@ def scale_to_coprime(v: FloatSequence) -> np.ndarray: return a * b // np.gcd(a, b) v_ = np.array(v) - m = (v_ * reduce(lcm, map(lambda x: int(get_square_denominator(x)),v_))**0.5).astype(int) + m = (v_ * reduce(lcm, map(lambda x: int(get_square_denominator(x)),v_))**0.5).astype(np.int64) m = m//reduce(np.gcd,m) with np.errstate(invalid='ignore'): From f6d960f785116f71ce2e41ee2f434d22b34e4872 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 2 Jun 2022 23:35:51 +0200 Subject: [PATCH 31/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-429-g5155a3f95 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 14284d5a5..f9bf90da4 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-422-gb8530bbcc +3.0.0-alpha6-429-g5155a3f95 From 1b5194288b8d9468b8d95c38c4b9086c6056110a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 27 May 2022 21:08:00 +0200 Subject: [PATCH 32/99] polished tests, consistent variable name --- PRIVATE | 2 +- examples/config/phase/damage/isobrittle_generic.yaml | 2 +- src/homogenization_damage.f90 | 1 + src/phase_damage_anisobrittle.f90 | 2 +- src/phase_damage_isobrittle.f90 | 4 ++-- 5 files changed, 6 insertions(+), 5 deletions(-) diff --git a/PRIVATE b/PRIVATE index 073819b26..226d7b627 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 073819b26248e2915bd5f3b6de7d4e0d27a3d423 +Subproject commit 226d7b627e44247b800bce0d9eb7bef1aac6f537 diff --git a/examples/config/phase/damage/isobrittle_generic.yaml b/examples/config/phase/damage/isobrittle_generic.yaml index 9de78448d..64a51fa42 100644 --- a/examples/config/phase/damage/isobrittle_generic.yaml +++ b/examples/config/phase/damage/isobrittle_generic.yaml @@ -2,6 +2,6 @@ type: isobrittle output: [f_phi] -G: 1400000.0 +G_crit: 1400000.0 l_c: 1.0 mu: 0.001 diff --git a/src/homogenization_damage.f90 b/src/homogenization_damage.f90 index 6ae4ac07a..53d6622ac 100644 --- a/src/homogenization_damage.f90 +++ b/src/homogenization_damage.f90 @@ -166,6 +166,7 @@ module subroutine damage_results(ho,group) integer :: o + associate(prm => param(ho)) outputsLoop: do o = 1,size(prm%output) select case(prm%output(o)) diff --git a/src/phase_damage_anisobrittle.f90 b/src/phase_damage_anisobrittle.f90 index f193119eb..167d0829b 100644 --- a/src/phase_damage_anisobrittle.f90 +++ b/src/phase_damage_anisobrittle.f90 @@ -157,7 +157,7 @@ module subroutine anisobrittle_results(phase,group) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') - call results_writeDataset(stt,group,trim(prm%output(o)),'driving force','J/m³') + call results_writeDataset(stt,group,trim(prm%output(o)),'driving force','-') end select end do outputsLoop end associate diff --git a/src/phase_damage_isobrittle.f90 b/src/phase_damage_isobrittle.f90 index 353ce9f00..36f26abd3 100644 --- a/src/phase_damage_isobrittle.f90 +++ b/src/phase_damage_isobrittle.f90 @@ -63,7 +63,7 @@ module function isobrittle_init() result(mySources) associate(prm => param(ph), dlt => deltaState(ph), stt => state(ph)) src => sources%get(1) - prm%W_crit = src%get_asFloat('G')/src%get_asFloat('l_c') + prm%W_crit = src%get_asFloat('G_crit')/src%get_asFloat('l_c') #if defined (__GFORTRAN__) prm%output = output_as1dString(src) @@ -139,7 +139,7 @@ module subroutine isobrittle_results(phase,group) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') - call results_writeDataset(stt,group,trim(prm%output(o)),'driving force','J/m³') ! Wrong, this is dimensionless + call results_writeDataset(stt,group,trim(prm%output(o)),'driving force','-') end select end do outputsLoop From 1d1782454096677a945605a609ac2cc54ed1de5a Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 4 Jun 2022 19:45:55 +0200 Subject: [PATCH 33/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-437-gfa974574a --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index f9bf90da4..9c89cfcc7 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-429-g5155a3f95 +3.0.0-alpha6-437-gfa974574a From 40658a66452595471843fe0a3c9bbba254f6f827 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Sun, 5 Jun 2022 21:39:06 +0000 Subject: [PATCH 34/99] fixed typo in Result.view example --- python/damask/_result.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/damask/_result.py b/python/damask/_result.py index 1ad25bdbf..b5b58bc04 100644 --- a/python/damask/_result.py +++ b/python/damask/_result.py @@ -334,7 +334,7 @@ class Result: >>> import damask >>> r = damask.Result('my_file.hdf5') - >>> r_first = r.view(increment=0) + >>> r_first = r.view(increments=0) Get a view that shows all results between simulation times of 10 to 40: From 30bedeb3bc5e336813939ede30ddd0f625e966ca Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 6 Jun 2022 02:57:17 +0200 Subject: [PATCH 35/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-439-g40658a664 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 9c89cfcc7..f636d9d5e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-437-gfa974574a +3.0.0-alpha6-439-g40658a664 From 5a284648ed2014ce95c0c5befc4958c23cdca1f5 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 7 Jun 2022 19:03:44 +0200 Subject: [PATCH 36/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-442-g49e40923e --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index f636d9d5e..6c99f4893 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-439-g40658a664 +3.0.0-alpha6-442-g49e40923e From ab2072bf2f5195389bd76d3bc9138d8532e57328 Mon Sep 17 00:00:00 2001 From: Daniel Otto de Mentock Date: Wed, 8 Jun 2022 15:50:35 +0200 Subject: [PATCH 37/99] apply_DAMASK_modifications script needs to be independent from damask installation (except solver variables) --- .../MarcMentat/apply_DAMASK_modifications.py | 48 +++++++++++++++---- 1 file changed, 40 insertions(+), 8 deletions(-) diff --git a/install/MarcMentat/apply_DAMASK_modifications.py b/install/MarcMentat/apply_DAMASK_modifications.py index a17120895..473d26da7 100755 --- a/install/MarcMentat/apply_DAMASK_modifications.py +++ b/install/MarcMentat/apply_DAMASK_modifications.py @@ -1,20 +1,51 @@ #!/usr/bin/env python3 - import os import sys import glob import argparse import shutil from pathlib import Path +import importlib.machinery +import signal +import subprocess +import shlex +from functools import partial + +solver = importlib.machinery.SourceFileLoader( + 'damask',f'{str(Path(__file__).parent.absolute().parents[1])}/python/damask/solver/_marc.py').load_module() + +def run(cmd, wd='./', env=None, timeout=None): + def pass_signal(sig,_,proc,default): + proc.send_signal(sig) + signal.signal(sig,default) + signal.raise_signal(sig) + signals = [signal.SIGINT,signal.SIGTERM] + print(f"running '{cmd}' in '{wd}'") + process = subprocess.Popen(shlex.split(cmd), + stdout = subprocess.PIPE, + stderr = subprocess.PIPE, + env = os.environ if env is None else env, + cwd = wd, + encoding = 'utf-8') + sig_states = [signal.signal(sig,partial(pass_signal,proc=process,default=signal.getsignal(sig))) for sig in signals] + try: + stdout,stderr = process.communicate(timeout=timeout) + finally: + for sig,state in zip(signals,sig_states): + signal.signal(sig,state) + if process.returncode != 0: + print(stdout) + print(stderr) + raise RuntimeError(f"'{cmd}' failed with returncode {process.returncode}") + return stdout, stderr -import damask def copy_and_patch(patch,orig,editor): try: shutil.copyfile(orig,orig.parent/patch.stem) except shutil.SameFileError: pass - damask.util.run(f'patch {orig.parent/patch.stem} {patch} --backup --forward') + run(f'patch {orig.parent/patch.stem} {patch} --backup --forward') with open(orig.parent/patch.stem) as f_in: content = f_in.read() with open(orig.parent/patch.stem,'w') as f_out: @@ -28,15 +59,16 @@ parser = argparse.ArgumentParser( parser.add_argument('--editor', dest='editor', metavar='string', default='vi', help='Name of the editor (executable) used by Marc Mentat') parser.add_argument('--marc-root', dest='marc_root', metavar='string', - default=damask.solver._marc._marc_root, + default=solver._marc_root, help='Marc root directory') parser.add_argument('--marc-version', dest='marc_version', metavar='string', - default=damask.solver._marc._marc_version, + default=solver._marc_version, help='Marc version') parser.add_argument('--damask-root', dest='damask_root', metavar = 'string', - default=damask.solver._marc._damask_root, + default=solver._damask_root, help='DAMASK root directory') + args = parser.parse_args() marc_root = Path(args.marc_root).expanduser() damask_root = Path(args.damask_root).expanduser() @@ -52,7 +84,7 @@ matches = {'Marc_tools': [['comp_user','comp_damask_*mp'], for cmd in ['patch','xvfb-run']: try: - damask.util.run(f'{cmd} --help') + run(f'{cmd} --help') except FileNotFoundError: print(f'"{cmd}" not found, please install') sys.exit() @@ -71,7 +103,7 @@ print('compiling Mentat menu binaries...') executable = marc_root/f'mentat{marc_version}/bin/mentat' menu_file = marc_root/f'mentat{marc_version}/menus/linux64/main.msb' -damask.util.run(f'xvfb-run -a {executable} -compile {menu_file}') +run(f'xvfb-run -a {executable} -compile {menu_file}') print('setting file access rights...') From 78838c2f75b087a1eb1c96929a866c50f63aac9c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 8 Jun 2022 23:06:01 +0200 Subject: [PATCH 38/99] consistent variants including space --- src/CLI.f90 | 26 ++++---- src/HDF5_utilities.f90 | 2 +- src/IO.f90 | 34 +++++----- src/YAML_parse.f90 | 22 +++---- src/YAML_types.f90 | 12 ++-- src/discretization.f90 | 2 +- src/homogenization.f90 | 14 ++--- src/homogenization_damage.f90 | 6 +- src/homogenization_mechanical_RGC.f90 | 2 +- src/lattice.f90 | 52 ++++++++-------- src/math.f90 | 68 ++++++++++---------- src/parallelization.f90 | 6 +- src/phase_mechanical.f90 | 72 +++++++++++----------- src/phase_mechanical_eigen.f90 | 2 +- src/phase_mechanical_plastic.f90 | 2 +- src/phase_mechanical_plastic_dislotwin.f90 | 4 +- src/phase_thermal.f90 | 26 ++++---- src/polynomials.f90 | 2 +- src/system_routines.f90 | 4 +- 19 files changed, 179 insertions(+), 179 deletions(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index ff3d7349f..cc73365d6 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -156,15 +156,15 @@ subroutine CLI_init if (CLI_restartInc < 0 .or. stat /=0) then print'(/,a)', ' ERROR: Could not parse restart increment: '//trim(arg) call quit(1) - endif + end if end select if (err /= 0) call quit(1) - enddo + end do if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0) then print'(/,a)', ' ERROR: Please specify geometry AND load case (-h for help)' call quit(1) - endif + end if if (len_trim(workingDirArg) > 0) call setWorkingDirectory(trim(workingDirArg)) CLI_geomFile = getGeometryFile(geometryArg) @@ -205,14 +205,14 @@ subroutine setWorkingDirectory(workingDirectoryArg) else absolutePath workingDirectory = getCWD() workingDirectory = trim(workingDirectory)//'/'//workingDirectoryArg - endif absolutePath + end if absolutePath workingDirectory = trim(rectifyPath(workingDirectory)) error = setCWD(trim(workingDirectory)) if(error) then print*, 'ERROR: Invalid Working directory: '//trim(workingDirectory) call quit(1) - endif + end if end subroutine setWorkingDirectory @@ -256,7 +256,7 @@ function getGeometryFile(geometryParameter) if (.not. file_exists) then print*, 'ERROR: Geometry file does not exists: '//trim(getGeometryFile) call quit(1) - endif + end if end function getGeometryFile @@ -279,7 +279,7 @@ function getLoadCaseFile(loadCaseParameter) if (.not. file_exists) then print*, 'ERROR: Load case file does not exists: '//trim(getLoadCaseFile) call quit(1) - endif + end if end function getLoadCaseFile @@ -300,14 +300,14 @@ function rectifyPath(path) l = len_trim(rectifyPath) do i = l,3,-1 if (rectifyPath(i-2:i) == '/./') rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' - enddo + end do !-------------------------------------------------------------------------------------------------- ! remove // from path l = len_trim(rectifyPath) do i = l,2,-1 if (rectifyPath(i-1:i) == '//') rectifyPath(i-1:l) = rectifyPath(i:l)//' ' - enddo + end do !-------------------------------------------------------------------------------------------------- ! remove ../ and corresponding directory from rectifyPath @@ -321,9 +321,9 @@ function rectifyPath(path) k = len_trim(rectifyPath) rectifyPath(j+1:k-1) = rectifyPath(j+2:k) rectifyPath(k:k) = ' ' - endif + end if i = j+index(rectifyPath(j+1:l),'../') - enddo + end do if(len_trim(rectifyPath) == 0) rectifyPath = '/' rectifyPath = trim(rectifyPath) @@ -349,10 +349,10 @@ function makeRelativePath(a,b) do i = 1, min(len_trim(a_cleaned),len_trim(rectifyPath(b_cleaned))) if (a_cleaned(i:i) /= b_cleaned(i:i)) exit if (a_cleaned(i:i) == '/') posLastCommonSlash = i - enddo + end do do i = posLastCommonSlash+1,len_trim(a_cleaned) if (a_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1 - enddo + end do makeRelativePath = repeat('..'//'/',remainingSlashes)//b_cleaned(posLastCommonSlash+1:len_trim(b_cleaned)) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index fcd2c189a..c905164c2 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -509,7 +509,7 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path) do i=1,size(attrValue) attrValue_(i) = attrValue(i)//C_NULL_CHAR ptr(i) = c_loc(attrValue_(i)) - enddo + end do call H5Screate_simple_f(1,shape(attrValue_,kind=HSIZE_T),space_id,hdferr,shape(attrValue_,kind=HSIZE_T)) if(hdferr < 0) error stop 'HDF5 error' diff --git a/src/IO.f90 b/src/IO.f90 index a6ecb1491..9b9b9d563 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -92,15 +92,15 @@ function IO_readlines(fileName) result(fileContent) if (.not. warned) then call IO_warning(207,trim(fileName),label1='line',ID1=l) warned = .true. - endif + end if else line = rawData(startPos:endpos) - endif + end if startPos = endPos + 2 ! jump to next line start fileContent(l) = trim(line)//'' l = l + 1 - enddo + end do end function IO_readlines @@ -129,7 +129,7 @@ function IO_read(fileName) result(fileContent) if (fileLength==0) then close(fileUnit) return - endif + end if read(fileUnit,iostat=myStat) fileContent if (myStat /= 0) call IO_error(102,trim(fileName)) @@ -183,8 +183,8 @@ pure function IO_stringPos(string) endOfString: if (right < left) then IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string) exit - endif endOfString - enddo + end if endOfString + end do end function IO_stringPos @@ -204,7 +204,7 @@ function IO_stringValue(string,chunkPos,myChunk) call IO_error(110,'IO_stringValue: "'//trim(string)//'"',label1='chunk',ID1=myChunk) else validChunk IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) - endif validChunk + end if validChunk end function IO_stringValue @@ -257,8 +257,8 @@ pure function IO_lc(string) IO_lc(i:i) = LOWER(n:n) else IO_lc(i:i) = string(i:i) - endif - enddo + end if + end do end function IO_lc @@ -280,7 +280,7 @@ function IO_rmComment(line) IO_rmComment = trim(line) else IO_rmComment = trim(line(:split-1)) - endif + end if end function IO_rmComment @@ -302,7 +302,7 @@ integer function IO_stringAsInt(string) else valid IO_stringAsInt = 0 call IO_error(111,string) - endif valid + end if valid end function IO_stringAsInt @@ -324,7 +324,7 @@ real(pReal) function IO_stringAsFloat(string) else valid IO_stringAsFloat = 0.0_pReal call IO_error(112,string) - endif valid + end if valid end function IO_stringAsFloat @@ -344,7 +344,7 @@ logical function IO_stringAsBool(string) else IO_stringAsBool = .false. call IO_error(113,string) - endif + end if end function IO_stringAsBool @@ -598,7 +598,7 @@ pure function CRLF2LF(string) CRLF2LF(c-n:c-n) = string(c:c) if (c == len_trim(string)) exit if (string(c:c+1) == CR//LF) n = n + 1 - enddo + end do CRLF2LF = CRLF2LF(:c-n) @@ -639,17 +639,17 @@ subroutine panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2) write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',& max(1,panelwidth+3-len_trim(ext_msg)-4),'x,a)' write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│' - endif + end if if (present(label1)) then write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',& max(1,panelwidth+3-len_trim(label1)-9-7),'x,a)' write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│' - endif + end if if (present(label2)) then write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',& max(1,panelwidth+3-len_trim(label2)-9-7),'x,a)' write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│' - endif + end if write(formatString,'(a,i2.2,a)') '(a,',max(1,panelwidth),'x,a)' write(IO_STDERR,formatString) ' │', '│' write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘' diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90 index a887476a9..67abfdd90 100644 --- a/src/YAML_parse.f90 +++ b/src/YAML_parse.f90 @@ -103,7 +103,7 @@ recursive function parse_flow(YAML_flow) result(node) class is (tDict) call node%set(key,myVal) end select - enddo + end do elseif (flow_string(1:1) == '[') then ! start of a list e = 1 allocate(tList::node) @@ -116,7 +116,7 @@ recursive function parse_flow(YAML_flow) result(node) class is (tList) call node%append(myVal) end select - enddo + end do else ! scalar value allocate(tScalar::node) select type (node) @@ -156,7 +156,7 @@ integer function find_end(str,e_char) N_sq = N_sq - merge(1,0,str(i:i) == ']') N_cu = N_cu - merge(1,0,str(i:i) == '}') i = i + 1 - enddo + end do find_end = i end function find_end @@ -333,7 +333,7 @@ subroutine skip_empty_lines(blck,s_blck) do while(empty .and. len_trim(blck(s_blck:)) /= 0) empty = len_trim(IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == 0 if(empty) s_blck = s_blck + index(blck(s_blck:),IO_EOL) - enddo + end do end subroutine skip_empty_lines @@ -387,7 +387,7 @@ logical function flow_is_closed(str,e_char) N_cu = N_cu + merge(1,0,line(i:i) == '{') N_sq = N_sq - merge(1,0,line(i:i) == ']') N_cu = N_cu - merge(1,0,line(i:i) == '}') - enddo + end do end function flow_is_closed @@ -410,7 +410,7 @@ subroutine remove_line_break(blck,s_blck,e_char,flow_line) flow_line = flow_line//IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))//' ' line_end = flow_is_closed(flow_line,e_char) s_blck = s_blck + index(blck(s_blck:),IO_EOL) - enddo + end do end subroutine remove_line_break @@ -439,7 +439,7 @@ subroutine list_item_inline(blck,s_blck,inline,offset) inline = inline//' '//trim(adjustl(IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)))) s_blck = s_blck + index(blck(s_blck:),IO_EOL) indent_next = indentDepth(blck(s_blck:)) - enddo + end do if(scan(inline,",") > 0) inline = '"'//inline//'"' @@ -481,7 +481,7 @@ recursive subroutine line_isFlow(flow,s_flow,line) flow(s_flow:s_flow+1) = ', ' s_flow = s_flow +2 s = s + find_end(line(s+1:),']') - enddo + end do s_flow = s_flow - 1 if (flow(s_flow-1:s_flow-1) == ',') s_flow = s_flow - 1 flow(s_flow:s_flow) = ']' @@ -498,7 +498,7 @@ recursive subroutine line_isFlow(flow,s_flow,line) flow(s_flow:s_flow+1) = ', ' s_flow = s_flow +2 s = s + find_end(line(s+1:),'}') - enddo + end do s_flow = s_flow -1 if(flow(s_flow-1:s_flow-1) == ',') s_flow = s_flow -1 flow(s_flow:s_flow) = '}' @@ -646,7 +646,7 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset) s_flow = s_flow + 2 end if - enddo + end do s_flow = s_flow - 1 if (flow(s_flow-1:s_flow-1) == ',') s_flow = s_flow - 1 @@ -733,7 +733,7 @@ recursive subroutine dct(blck,flow,s_blck,s_flow,offset) flow(s_flow:s_flow) = ' ' s_flow = s_flow + 1 offset = 0 - enddo + end do s_flow = s_flow - 1 if (flow(s_flow-1:s_flow-1) == ',') s_flow = s_flow - 1 diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index 857b24bd0..e685209e6 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -411,7 +411,7 @@ function tNode_get_byIndex(self,i) result(node) do j = 2,i item => item%next - enddo + end do node => item%node end function tNode_get_byIndex @@ -681,7 +681,7 @@ function tNode_contains(self,k) result(exists) exists = .true. return end if - enddo + end do class is(tList) list => self%asList() do j=1, list%length @@ -689,7 +689,7 @@ function tNode_contains(self,k) result(exists) exists = .true. return end if - enddo + end do class default call IO_error(706,ext_msg='Expected list or dict') end select @@ -731,7 +731,7 @@ function tNode_get_byKey(self,k,defaultVal) result(node) end if item => item%next j = j + 1 - enddo + end do if (.not. found) then call IO_error(143,ext_msg=k) @@ -1333,7 +1333,7 @@ function tList_as1dString(self) scalar => item%node%asScalar() tList_as1dString(i) = scalar%asString() item => item%next - enddo + end do end function tList_as1dString @@ -1384,7 +1384,7 @@ subroutine tDict_set(self,key,node) searchExisting: do while (associated(item%next)) if (item%key == key) exit item => item%next - enddo searchExisting + end do searchExisting if (item%key /= key) then allocate(item%next) item => item%next diff --git a/src/discretization.f90 b/src/discretization.f90 index 5f4d1c5a6..95fd39fd5 100644 --- a/src/discretization.f90 +++ b/src/discretization.f90 @@ -68,7 +68,7 @@ subroutine discretization_init(materialAt,& discretization_sharedNodesBegin = sharedNodesBegin else discretization_sharedNodesBegin = size(discretization_NodeCoords0,2) - endif + end if end subroutine discretization_init diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 203c7bb1c..290f3de9b 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -365,7 +365,7 @@ subroutine homogenization_results call thermal_results(ho,group) end if - enddo + end do end subroutine homogenization_results @@ -383,7 +383,7 @@ subroutine homogenization_forward homogState (ho)%state0 = homogState (ho)%state if(damageState_h(ho)%sizeState > 0) & damageState_h(ho)%state0 = damageState_h(ho)%state - enddo + end do end subroutine homogenization_forward @@ -408,7 +408,7 @@ subroutine homogenization_restartWrite(fileHandle) call HDF5_closeGroup(groupHandle(2)) - enddo + end do call HDF5_closeGroup(groupHandle(1)) @@ -435,7 +435,7 @@ subroutine homogenization_restartRead(fileHandle) call HDF5_closeGroup(groupHandle(2)) - enddo + end do call HDF5_closeGroup(groupHandle(1)) @@ -476,7 +476,7 @@ subroutine parseHomogenization case default call IO_error(500,ext_msg=homogThermal%get_asString('type')) end select - endif + end if if (homog%contains('damage')) then homogDamage => homog%get('damage') @@ -486,8 +486,8 @@ subroutine parseHomogenization case default call IO_error(500,ext_msg=homogDamage%get_asString('type')) end select - endif - enddo + end if + end do end subroutine parseHomogenization diff --git a/src/homogenization_damage.f90 b/src/homogenization_damage.f90 index 53d6622ac..2e66da591 100644 --- a/src/homogenization_damage.f90 +++ b/src/homogenization_damage.f90 @@ -65,9 +65,9 @@ module subroutine damage_init() allocate(damageState_h(ho)%state (1,Nmembers), source=1.0_pReal) else prm%output = emptyStringArray - endif + end if end associate - enddo + end do call pass_init() @@ -174,7 +174,7 @@ module subroutine damage_results(ho,group) call results_writeDataset(damagestate_h(ho)%state(1,:),group,prm%output(o),& 'damage indicator','-') end select - enddo outputsLoop + end do outputsLoop end associate end subroutine damage_results diff --git a/src/homogenization_mechanical_RGC.f90 b/src/homogenization_mechanical_RGC.f90 index c74b9fb6c..911def035 100644 --- a/src/homogenization_mechanical_RGC.f90 +++ b/src/homogenization_mechanical_RGC.f90 @@ -561,7 +561,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy) *cosh(prm%c_alpha*nDefNorm) & *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_LeviCivita(k,l,j) & *tanh(nDefNorm/num%xSmoo) - end do; end do;enddo; end do + end do; end do;end do; end do end do interfaceLoop diff --git a/src/lattice.f90 b/src/lattice.f90 index 1496deb78..2c2da345d 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -484,8 +484,8 @@ function lattice_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character case default call IO_error(137,ext_msg='lattice_characteristicShear_Twin: '//trim(lattice)) end select - enddo mySystems - enddo myFamilies + end do mySystems + end do myFamilies end function lattice_characteristicShear_Twin @@ -523,7 +523,7 @@ function lattice_C66_twin(Ntwin,C66,lattice,CoverA) do i = 1, sum(Ntwin) call R%fromAxisAngle([coordinateSystem(1:3,2,i),PI],P=1) ! ToDo: Why always 180 deg? lattice_C66_twin(1:6,1:6,i) = R%rotStiffness(C66) - enddo + end do end function lattice_C66_twin @@ -572,19 +572,19 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, & C_target_unrotated66 = C_parent66 else call IO_error(137,ext_msg='lattice_C66_trans : '//trim(lattice_target)) - endif + end if do i = 1,6 if (abs(C_target_unrotated66(i,i))5) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & + nonSchmidCoefficients(6) * math_outer(direction, direction) - enddo + end do end function lattice_nonSchmidMatrix @@ -1432,7 +1432,7 @@ function lattice_SchmidMatrix_slip(Nslip,lattice,cOverA) result(SchmidMatrix) SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & error stop 'dilatational Schmid matrix for slip' - enddo + end do end function lattice_SchmidMatrix_slip @@ -1479,7 +1479,7 @@ function lattice_SchmidMatrix_twin(Ntwin,lattice,cOverA) result(SchmidMatrix) SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & error stop 'dilatational Schmid matrix for twin' - enddo + end do end function lattice_SchmidMatrix_twin @@ -1552,7 +1552,7 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,lattice,cOverA) result(SchmidMa SchmidMatrix(1:3,1:3,1,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) SchmidMatrix(1:3,1:3,2,i) = math_outer(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i)) SchmidMatrix(1:3,1:3,3,i) = math_outer(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i)) - enddo + end do end function lattice_SchmidMatrix_cleavage @@ -1719,8 +1719,8 @@ pure function lattice_symmetrize_C66(C66,lattice) result(C66_sym) do i = 1, 6 do j = i+1, 6 C66_sym(j,i) = C66_sym(i,j) - enddo - enddo + end do + end do end function lattice_symmetrize_C66 @@ -1782,7 +1782,7 @@ function slipProjection_transverse(Nslip,lattice,cOverA) result(projection) do i=1, sum(Nslip); do j=1, sum(Nslip) projection(i,j) = abs(math_inner(n(:,i),t(:,j))) - enddo; enddo + end do; end do end function slipProjection_transverse @@ -1806,7 +1806,7 @@ function slipProjection_direction(Nslip,lattice,cOverA) result(projection) do i=1, sum(Nslip); do j=1, sum(Nslip) projection(i,j) = abs(math_inner(n(:,i),d(:,j))) - enddo; enddo + end do; end do end function slipProjection_direction @@ -1890,8 +1890,8 @@ function buildInteraction(reacting_used,acting_used,reacting_max,acting_max,valu buildInteraction(l,k) = values(matrix(i,j)) - enddo; enddo - enddo; enddo + end do; end do + end do; end do end function buildInteraction @@ -1957,8 +1957,8 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA) buildCoordinateSystem(1:3,3,a) = math_cross(direction/norm2(direction),& normal /norm2(normal)) - enddo activeSystems - enddo activeFamilies + end do activeSystems + end do activeFamilies end function buildCoordinateSystem @@ -2066,7 +2066,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI) U = (a_cI/a_cF) * (math_outer(x,x) + (math_outer(y,y)+math_outer(z,z)) * sqrt(2.0_pReal)) Q(1:3,1:3,i) = matmul(R%asMatrix(),B%asMatrix()) S(1:3,1:3,i) = matmul(R%asMatrix(),U) - MATH_I3 - enddo + end do else if (present(cOverA)) then ss = MATH_I3 sd = MATH_I3 @@ -2125,7 +2125,7 @@ function getlabels(active,potential,system) result(labels) write(label(i+1:i+2),'(I2.1)') int(system(j,p)) label(i+3:i+3) = ' ' i = i + 3 - enddo direction + end do direction label(i:i) = ']' i = i +1 @@ -2134,13 +2134,13 @@ function getlabels(active,potential,system) result(labels) write(label(i+1:i+2),'(I2.1)') int(system(j,p)) label(i+3:i+3) = ' ' i = i + 3 - enddo normal + end do normal label(i:i) = ')' labels(a) = label - enddo activeSystems - enddo activeFamilies + end do activeSystems + end do activeFamilies end function getlabels @@ -2170,7 +2170,7 @@ pure function lattice_equivalent_nu(C,assumption) result(nu) / (S(1,1)+S(2,2)+S(3,3) +2.0_pReal*(S(1,2)+S(2,3)+S(1,3))) else error stop 'invalid assumption' - endif + end if mu = lattice_equivalent_mu(C,assumption) nu = (1.5_pReal*K-mu)/(3.0_pReal*K+mu) @@ -2202,7 +2202,7 @@ pure function lattice_equivalent_mu(C,assumption) result(mu) / (4.0_pReal*(S(1,1)+S(2,2)+S(3,3)) -4.0_pReal*(S(1,2)+S(2,3)+S(1,3)) +3.0_pReal*(S(4,4)+S(5,5)+S(6,6))) else error stop 'invalid assumption' - endif + end if end function lattice_equivalent_mu @@ -2266,7 +2266,7 @@ subroutine selfTest if (any(dNeq(T(1,1),[T_hP(1,1),T_hP(2,2)]))) error stop 'Symmetry33_11-22/hP' if (any(dNeq(T(1,1),[T_tI(1,1),T_tI(2,2)]))) error stop 'Symmetry33_11-22/tI' - enddo + end do call random_number(C) C(1,1) = C(1,1) + C(1,2) + 0.1_pReal diff --git a/src/math.f90 b/src/math.f90 index 25c90ccf4..ef269be37 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -135,25 +135,25 @@ pure recursive subroutine math_sort(a, istart, iend, sortDim) s = istart else s = lbound(a,2) - endif + end if if (present(iend)) then e = iend else e = ubound(a,2) - endif + end if if (present(sortDim)) then d = sortDim else d = 1 - endif + end if if (s < e) then call qsort_partition(a,ipivot, s,e, d) call math_sort(a, s, ipivot-1, d) call math_sort(a, ipivot+1, e, d) - endif + end if contains @@ -175,11 +175,11 @@ pure recursive subroutine math_sort(a, istart, iend, sortDim) ! find the first element on the right side less than or equal to the pivot point do j = iend, istart, -1 if (a(sort,j) <= a(sort,istart)) exit - enddo + end do ! find the first element on the left side greater than the pivot point do i = istart, iend if (a(sort,i) > a(sort,istart)) exit - enddo + end do cross: if (i >= j) then ! exchange left value with pivot and return with the partition index tmp = a(:,istart) a(:,istart) = a(:,j) @@ -190,8 +190,8 @@ pure recursive subroutine math_sort(a, istart, iend, sortDim) tmp = a(:,i) a(:,i) = a(:,j) a(:,j) = tmp - endif cross - enddo + end if cross + end do end subroutine qsort_partition @@ -216,7 +216,7 @@ pure function math_expand(what,how) do i = 1, size(how) math_expand(sum(how(1:i-1))+1:sum(how(1:i))) = what(mod(i-1,size(what))+1) - enddo + end do end function math_expand @@ -251,7 +251,7 @@ pure function math_eye(d) math_eye = 0.0_pReal do i=1,d math_eye(i,i) = 1.0_pReal - enddo + end do end function math_eye @@ -270,7 +270,7 @@ pure function math_identity4th() #ifndef __INTEL_COMPILER do concurrent(i=1:3, j=1:3, k=1:3, l=1:3) math_identity4th(i,j,k,l) = 0.5_pReal*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k)) - enddo + end do #else forall(i=1:3, j=1:3, k=1:3, l=1:3) & math_identity4th(i,j,k,l) = 0.5_pReal*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k)) @@ -298,7 +298,7 @@ real(pReal) pure function math_LeviCivita(i,j,k) math_LeviCivita = -1.0_pReal else math_LeviCivita = 0.0_pReal - endif + end if end function math_LeviCivita @@ -348,7 +348,7 @@ pure function math_outer(A,B) #ifndef __INTEL_COMPILER do concurrent(i=1:size(A,1), j=1:size(B,1)) math_outer(i,j) = A(i)*B(j) - enddo + end do #else forall(i=1:size(A,1), j=1:size(B,1)) math_outer(i,j) = A(i)*B(j) #endif @@ -398,7 +398,7 @@ pure function math_mul3333xx33(A,B) #ifndef __INTEL_COMPILER do concurrent(i=1:3, j=1:3) math_mul3333xx33(i,j) = sum(A(i,j,1:3,1:3)*B(1:3,1:3)) - enddo + end do #else forall (i=1:3, j=1:3) math_mul3333xx33(i,j) = sum(A(i,j,1:3,1:3)*B(1:3,1:3)) #endif @@ -421,7 +421,7 @@ pure function math_mul3333xx3333(A,B) #ifndef __INTEL_COMPILER do concurrent(i=1:3, j=1:3, k=1:3, l=1:3) math_mul3333xx3333(i,j,k,l) = sum(A(i,j,1:3,1:3)*B(1:3,1:3,k,l)) - enddo + end do #else forall(i=1:3, j=1:3, k=1:3, l=1:3) math_mul3333xx3333(i,j,k,l) = sum(A(i,j,1:3,1:3)*B(1:3,1:3,k,l)) #endif @@ -446,7 +446,7 @@ pure function math_exp33(A,n) n_ = n else n_ = 5 - endif + end if invFac = 1.0_pReal ! 0! B = math_I3 @@ -456,7 +456,7 @@ pure function math_exp33(A,n) invFac = invFac/real(i,pReal) ! invfac = 1/(i!) B = matmul(B,A) math_exp33 = math_exp33 + invFac*B ! exp = SUM (A^i)/(i!) - enddo + end do end function math_exp33 @@ -514,7 +514,7 @@ pure subroutine math_invert33(InvA, DetA, error, A) InvA = InvA/DetA error = .false. - endif + end if end subroutine math_invert33 @@ -541,7 +541,7 @@ pure function math_invSym3333(A) error stop 'matrix inversion error' else math_invSym3333 = math_66toSym3333(temp66) - endif + end if end function math_invSym3333 @@ -696,7 +696,7 @@ pure function math_9to33(v9) do i = 1, 9 math_9to33(MAPPLAIN(1,i),MAPPLAIN(2,i)) = v9(i) - enddo + end do end function math_9to33 @@ -721,7 +721,7 @@ pure function math_sym33to6(m33,weighted) w = merge(NRMMANDEL,1.0_pReal,weighted) else w = NRMMANDEL - endif + end if math_sym33to6 = [(w(i)*m33(MAPNYE(1,i),MAPNYE(2,i)),i=1,6)] @@ -748,12 +748,12 @@ pure function math_6toSym33(v6,weighted) w = merge(INVNRMMANDEL,1.0_pReal,weighted) else w = INVNRMMANDEL - endif + end if do i=1,6 math_6toSym33(MAPNYE(1,i),MAPNYE(2,i)) = w(i)*v6(i) math_6toSym33(MAPNYE(2,i),MAPNYE(1,i)) = w(i)*v6(i) - enddo + end do end function math_6toSym33 @@ -772,7 +772,7 @@ pure function math_3333to99(m3333) #ifndef __INTEL_COMPILER do concurrent(i=1:9, j=1:9) math_3333to99(i,j) = m3333(MAPPLAIN(1,i),MAPPLAIN(2,i),MAPPLAIN(1,j),MAPPLAIN(2,j)) - enddo + end do #else forall(i=1:9, j=1:9) math_3333to99(i,j) = m3333(MAPPLAIN(1,i),MAPPLAIN(2,i),MAPPLAIN(1,j),MAPPLAIN(2,j)) #endif @@ -794,7 +794,7 @@ pure function math_99to3333(m99) #ifndef __INTEL_COMPILER do concurrent(i=1:9, j=1:9) math_99to3333(MAPPLAIN(1,i),MAPPLAIN(2,i),MAPPLAIN(1,j),MAPPLAIN(2,j)) = m99(i,j) - enddo + end do #else forall(i=1:9, j=1:9) math_99to3333(MAPPLAIN(1,i),MAPPLAIN(2,i),MAPPLAIN(1,j),MAPPLAIN(2,j)) = m99(i,j) #endif @@ -827,7 +827,7 @@ pure function math_sym3333to66(m3333,weighted) #ifndef __INTEL_COMPILER do concurrent(i=1:6, j=1:6) math_sym3333to66(i,j) = w(i)*w(j)*m3333(MAPNYE(1,i),MAPNYE(2,i),MAPNYE(1,j),MAPNYE(2,j)) - enddo + end do #else forall(i=1:6, j=1:6) math_sym3333to66(i,j) = w(i)*w(j)*m3333(MAPNYE(1,i),MAPNYE(2,i),MAPNYE(1,j),MAPNYE(2,j)) #endif @@ -1080,8 +1080,8 @@ pure subroutine math_eigh33(w,v,m) else fallback2 v(1:3,2) = v(1:3, 2) / norm v(1:3,3) = math_cross(v(1:3,1),v(1:3,2)) - endif fallback2 - endif fallback1 + end if fallback2 + end if fallback1 end subroutine math_eigh33 @@ -1120,7 +1120,7 @@ pure function math_rotationalPart(F) result(R) lambda = sqrt(math_clip(lambda,0.0_pReal)/3.0_pReal) else lambda = sqrt(I_C(1)/3.0_pReal) - endif + end if I_U = [sum(lambda), lambda(1)*lambda(2)+lambda(2)*lambda(3)+lambda(3)*lambda(1), product(lambda)] @@ -1188,7 +1188,7 @@ pure function math_eigvalsh33(m) cos((phi+2.0_pReal*TAU)/3.0_pReal) & ] & + I(1)/3.0_pReal - endif + end if end function math_eigvalsh33 @@ -1238,7 +1238,7 @@ integer pure function math_binomial(n,k) do i = 1, k_ math_binomial = (math_binomial * n_)/i n_ = n_ -1 - enddo + end do end function math_binomial @@ -1302,7 +1302,7 @@ real(pReal) pure elemental function math_clip(a, left, right) if (present(right)) math_clip = min(right,math_clip) if (present(left) .and. present(right)) then if (left>right) error stop 'left > right' - endif + end if end function math_clip @@ -1402,7 +1402,7 @@ subroutine selfTest() do while(abs(math_det33(t33))<1.0e-9_pReal) call random_number(t33) - enddo + end do if (any(dNeq0(matmul(t33,math_inv33(t33)) - math_eye(3),tol=1.0e-9_pReal))) & error stop 'math_inv33' @@ -1418,7 +1418,7 @@ subroutine selfTest() do while(math_det33(t33)<1.0e-2_pReal) ! O(det(F)) = 1 call random_number(t33) - enddo + end do t33_2 = math_rotationalPart(transpose(t33)) t33 = math_rotationalPart(t33) if (any(dNeq0(matmul(t33_2,t33) - math_I3,tol=1.0e-10_pReal))) & diff --git a/src/parallelization.f90 b/src/parallelization.f90 index 44e5c86ae..d631711d8 100644 --- a/src/parallelization.f90 +++ b/src/parallelization.f90 @@ -97,7 +97,7 @@ subroutine parallelization_init open(OUTPUT_UNIT,file='/dev/null',status='replace') ! close() alone will leave some temp files in cwd else open(OUTPUT_UNIT,encoding='UTF-8') ! for special characters in output - endif + end if #endif print'(/,1x,a)', '<<<+- parallelization init -+>>>' @@ -142,8 +142,8 @@ subroutine parallelization_init !$ if (OMP_NUM_THREADS < 1_pI32) then !$ print'(1x,a)', 'Invalid OMP_NUM_THREADS: "'//trim(NumThreadsString)//'", using default' !$ OMP_NUM_THREADS = 4_pI32 -!$ endif -!$ endif +!$ end if +!$ end if !$ print'(1x,a,i0)', 'OMP_NUM_THREADS: ',OMP_NUM_THREADS !$ call omp_set_num_threads(OMP_NUM_THREADS) diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90 index afde549fc..93357bee5 100644 --- a/src/phase_mechanical.f90 +++ b/src/phase_mechanical.f90 @@ -255,7 +255,7 @@ module subroutine mechanical_init(phases) #else output_mechanical(ph)%label = mech%get_as1dString('output',defaultVal=emptyStringArray) #endif - enddo + end do do ce = 1, size(material_phaseID,2) ma = discretization_materialAt((ce-1)/discretization_nIPs+1) @@ -267,14 +267,14 @@ module subroutine mechanical_init(phases) phase_mechanical_Fe(ph)%data(1:3,1:3,en) = matmul(material_V_e_0(ma)%data(1:3,1:3,co), & transpose(phase_mechanical_Fp(ph)%data(1:3,1:3,en))) phase_mechanical_Fi(ph)%data(1:3,1:3,en) = material_O_0(ma)%data(co)%rotate(math_inv33(material_V_e_0(ma)%data(1:3,1:3,co))) - enddo - enddo + end do + end do do ph = 1, phases%length phase_mechanical_F0(ph)%data = phase_mechanical_F(ph)%data phase_mechanical_Fp0(ph)%data = phase_mechanical_Fp(ph)%data phase_mechanical_Fi0(ph)%data = phase_mechanical_Fi(ph)%data - enddo + end do call elastic_init(phases) @@ -284,7 +284,7 @@ module subroutine mechanical_init(phases) call plastic_init() do ph = 1,phases%length plasticState(ph)%state0 = plasticState(ph)%state - enddo + end do num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) @@ -473,25 +473,25 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken) Lpguess = Lpguess_old & + deltaLp * stepLengthLp cycle LpLoop - endif + end if calculateJacobiLp: if (mod(jacoCounterLp, num%iJacoLpresiduum) == 0) then jacoCounterLp = jacoCounterLp + 1 do o=1,3; do p=1,3 dFe_dLp(o,1:3,p,1:3) = - Delta_t * A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -Delta_t * A(i,k) invFi(l,j) - enddo; enddo + end do; end do dRLp_dLp = math_eye(9) & - math_3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) temp_9 = math_33to9(residuumLp) call dgesv(9,1,dRLp_dLp,9,devNull_9,temp_9,9,ierr) ! solve dRLp/dLp * delta Lp = -res for delta Lp if (ierr /= 0) return ! error deltaLp = - math_9to33(temp_9) - endif calculateJacobiLp + end if calculateJacobiLp Lpguess = Lpguess & + deltaLp * steplengthLp - enddo LpLoop + end do LpLoop call phase_LiAndItsTangents(Li_constitutive, dLi_dS, dLi_dFi, & S, Fi_new, ph,en) @@ -513,7 +513,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken) Liguess = Liguess_old & + deltaLi * steplengthLi cycle LiLoop - endif + end if calculateJacobiLi: if (mod(jacoCounterLi, num%iJacoLpresiduum) == 0) then jacoCounterLi = jacoCounterLi + 1 @@ -522,10 +522,10 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken) do o=1,3; do p=1,3 dFe_dLi(1:3,o,1:3,p) = -Delta_t*math_I3(o,p)*temp_33 ! dFe_dLp(i,j,k,l) = -Delta_t * A(i,k) invFi(l,j) dFi_dLi(1:3,o,1:3,p) = -Delta_t*math_I3(o,p)*invFi_current - enddo; enddo + end do; end do do o=1,3; do p=1,3 dFi_dLi(1:3,1:3,o,p) = matmul(matmul(Fi_new,dFi_dLi(1:3,1:3,o,p)),Fi_new) - enddo; enddo + end do; end do dRLi_dLi = math_eye(9) & - math_3333to99(math_mul3333xx3333(dLi_dS, math_mul3333xx3333(dS_dFe, dFe_dLi) & + math_mul3333xx3333(dS_dFi, dFi_dLi))) & @@ -534,11 +534,11 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken) call dgesv(9,1,dRLi_dLi,9,devNull_9,temp_9,9,ierr) ! solve dRLi/dLp * delta Li = -res for delta Li if (ierr /= 0) return ! error deltaLi = - math_9to33(temp_9) - endif calculateJacobiLi + end if calculateJacobiLi Liguess = Liguess & + deltaLi * steplengthLi - enddo LiLoop + end do LiLoop invFp_new = matmul(invFp_current,B) call math_invert33(Fp_new,devNull,error,invFp_new) @@ -613,9 +613,9 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b if (converged(r,plasticState(ph)%state(1:sizeDotState,en),plasticState(ph)%atol(1:sizeDotState))) then broken = plastic_deltaState(ph,en) exit iteration - endif + end if - enddo iteration + end do iteration contains @@ -638,7 +638,7 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) else damper = 1.0_pReal - endif + end if end function damper @@ -844,7 +844,7 @@ function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB) #else dotState = IEEE_FMA(A(n,stage),plastic_RKdotState(1:sizeDotState,n),dotState) #endif - enddo + end do #ifndef __INTEL_LLVM_COMPILER plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState*Delta_t @@ -858,7 +858,7 @@ function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB) dotState = plastic_dotState(Delta_t*C(stage), ph,en) if (any(IEEE_is_NaN(dotState))) exit - enddo + end do if(broken) return @@ -950,7 +950,7 @@ subroutine results(group,ph) do i = 1, size(dataset,1) to_quaternion(:,i) = dataset(i)%asQuaternion() - enddo + end do end function to_quaternion @@ -974,7 +974,7 @@ module subroutine mechanical_forward() phase_mechanical_Lp0(ph) = phase_mechanical_Lp(ph) phase_mechanical_S0(ph) = phase_mechanical_S(ph) plasticState(ph)%state0 = plasticState(ph)%state - enddo + end do end subroutine mechanical_forward @@ -1037,7 +1037,7 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_) subFp0 = phase_mechanical_Fp(ph)%data(1:3,1:3,en) subFi0 = phase_mechanical_Fi(ph)%data(1:3,1:3,en) subState0 = plasticState(ph)%state(:,en) - endif + end if !-------------------------------------------------------------------------------------------------- ! cut back (reduced time and restore) else @@ -1048,10 +1048,10 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_) if (subStep < 1.0_pReal) then ! actual (not initial) cutback phase_mechanical_Lp(ph)%data(1:3,1:3,en) = subLp0 phase_mechanical_Li(ph)%data(1:3,1:3,en) = subLi0 - endif + end if plasticState(ph)%state(:,en) = subState0 todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) - endif + end if !-------------------------------------------------------------------------------------------------- ! prepare for integration @@ -1060,9 +1060,9 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_) subF = subF0 & + subStep * (phase_mechanical_F(ph)%data(1:3,1:3,en) - phase_mechanical_F0(ph)%data(1:3,1:3,en)) converged_ = .not. integrateState(subF0,subF,subFp0,subFi0,subState0(1:sizeDotState),subStep * Delta_t,ph,en) - endif + end if - enddo cutbackLooping + end do cutbackLooping end function phase_mechanical_constitutive @@ -1086,14 +1086,14 @@ module subroutine mechanical_restore(ce,includeL) if (includeL) then phase_mechanical_Lp(ph)%data(1:3,1:3,en) = phase_mechanical_Lp0(ph)%data(1:3,1:3,en) phase_mechanical_Li(ph)%data(1:3,1:3,en) = phase_mechanical_Li0(ph)%data(1:3,1:3,en) - endif ! maybe protecting everything from overwriting makes more sense + end if ! maybe protecting everything from overwriting makes more sense phase_mechanical_Fp(ph)%data(1:3,1:3,en) = phase_mechanical_Fp0(ph)%data(1:3,1:3,en) phase_mechanical_Fi(ph)%data(1:3,1:3,en) = phase_mechanical_Fi0(ph)%data(1:3,1:3,en) phase_mechanical_S(ph)%data(1:3,1:3,en) = phase_mechanical_S0(ph)%data(1:3,1:3,en) plasticState(ph)%state(:,en) = plasticState(ph)%State0(:,en) - enddo + end do end subroutine mechanical_restore @@ -1164,7 +1164,7 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF) lhs_3333(1:3,o,1:3,p) = IEEE_FMA(invFi,invFi(p,o),lhs_3333(1:3,o,1:3,p)) rhs_3333(1:3,1:3,o,p) = IEEE_FMA(matmul(invSubFi0,dLidS(1:3,1:3,o,p)),-Delta_t,rhs_3333(1:3,1:3,o,p)) #endif - enddo; enddo + end do; end do call math_invert(temp_99,error,math_3333to99(lhs_3333)) if (error) then call IO_warning(600,'inversion error in analytic tangent calculation', & @@ -1172,9 +1172,9 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF) dFidS = 0.0_pReal else dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif + end if dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS - endif + end if call plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & phase_mechanical_S(ph)%data(1:3,1:3,en), & @@ -1191,7 +1191,7 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF) rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) - enddo; enddo + end do; end do #ifndef __INTEL_LLVM_COMPILER lhs_3333 = math_mul3333xx3333(dSdFe,temp_3333) * Delta_t & + math_mul3333xx3333(dSdFi,dFidS) @@ -1206,14 +1206,14 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF) dSdF = rhs_3333 else dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif + end if !-------------------------------------------------------------------------------------------------- ! calculate dFpinvdF temp_3333 = math_mul3333xx3333(dLpdS,dSdF) do o=1,3; do p=1,3 dFpinvdF(1:3,1:3,p,o) = - matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) * Delta_t - enddo; enddo + end do; end do !-------------------------------------------------------------------------------------------------- ! assemble dPdF @@ -1224,13 +1224,13 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF) dPdF = 0.0_pReal do p=1,3 dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1)) - enddo + end do do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & + matmul(matmul(phase_mechanical_F(ph)%data(1:3,1:3,en),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)),transpose(invFp)) & + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) - enddo; enddo + end do; end do end function phase_mechanical_dPdF diff --git a/src/phase_mechanical_eigen.f90 b/src/phase_mechanical_eigen.f90 index f0b86319c..4cd02d090 100644 --- a/src/phase_mechanical_eigen.f90 +++ b/src/phase_mechanical_eigen.f90 @@ -61,7 +61,7 @@ module subroutine eigen_init(phases) if (maxval(Nmodels) /= 0) then where(thermalexpansion_init(maxval(Nmodels))) model = EIGEN_thermal_expansion_ID - endif + end if allocate(model_damage(phases%length), source = EIGEN_UNDEFINED_ID) diff --git a/src/phase_mechanical_plastic.f90 b/src/phase_mechanical_plastic.f90 index 15a8ae2a7..6469c6e45 100644 --- a/src/phase_mechanical_plastic.f90 +++ b/src/phase_mechanical_plastic.f90 @@ -435,7 +435,7 @@ function plastic_active(plastic_label) result(active_plastic) mech => phase%get('mechanical') pl => mech%get('plastic',defaultVal = emptyDict) active_plastic(ph) = pl%get_asString('type',defaultVal='none') == plastic_label - enddo + end do end function plastic_active diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index a29efeb56..858ef5955 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -364,13 +364,13 @@ module function plastic_dislotwin_init() result(myPlasticity) prm%h_sl_tw = lattice_interaction_SlipByTwin(N_sl,prm%N_tw,pl%get_as1dFloat('h_sl-tw'), & phase_lattice(ph)) if (prm%fccTwinTransNucleation .and. size(prm%N_tw) /= 1) extmsg = trim(extmsg)//' N_tw: nucleation' - endif slipAndTwinActive + end if slipAndTwinActive slipAndTransActive: if (prm%sum_N_sl * prm%sum_N_tr > 0) then prm%h_sl_tr = lattice_interaction_SlipByTrans(N_sl,prm%N_tr,pl%get_as1dFloat('h_sl-tr'), & phase_lattice(ph)) if (prm%fccTwinTransNucleation .and. size(prm%N_tr) /= 1) extmsg = trim(extmsg)//' N_tr: nucleation' - endif slipAndTransActive + end if slipAndTransActive !-------------------------------------------------------------------------------------------------- ! allocate state arrays diff --git a/src/phase_thermal.f90 b/src/phase_thermal.f90 index 2aab37529..0f5836df9 100644 --- a/src/phase_thermal.f90 +++ b/src/phase_thermal.f90 @@ -122,25 +122,25 @@ module subroutine thermal_init(phases) allocate(thermalstate(ph)%p(thermal_Nsources(ph))) - enddo + end do allocate(thermal_source(maxval(thermal_Nsources),phases%length), source = THERMAL_UNDEFINED_ID) if (maxval(thermal_Nsources) /= 0) then where(dissipation_init (maxval(thermal_Nsources))) thermal_source = THERMAL_DISSIPATION_ID where(externalheat_init(maxval(thermal_Nsources))) thermal_source = THERMAL_EXTERNALHEAT_ID - endif + end if thermal_source_maxSizeDotState = 0 do ph = 1,phases%length do so = 1,thermal_Nsources(ph) thermalState(ph)%p(so)%state = thermalState(ph)%p(so)%state0 - enddo + end do thermal_source_maxSizeDotState = max(thermal_source_maxSizeDotState, & maxval(thermalState(ph)%p%sizeDotState)) - enddo + end do end subroutine thermal_init @@ -170,7 +170,7 @@ module function phase_f_T(ph,en) result(f) end select - enddo + end do end function phase_f_T @@ -195,7 +195,7 @@ function phase_thermal_collectDotState(ph,en) result(broken) broken = broken .or. any(IEEE_is_NaN(thermalState(ph)%p(i)%dotState(:,en))) - enddo SourceLoop + end do SourceLoop end function phase_thermal_collectDotState @@ -262,7 +262,7 @@ function integrateThermalState(Delta_t, ph,en) result(broken) sizeDotState = thermalState(ph)%p(so)%sizeDotState thermalState(ph)%p(so)%state(1:sizeDotState,en) = thermalState(ph)%p(so)%state0(1:sizeDotState,en) & + thermalState(ph)%p(so)%dotState(1:sizeDotState,en) * Delta_t - enddo + end do end function integrateThermalState @@ -277,7 +277,7 @@ module subroutine thermal_restartWrite(groupHandle,ph) do so = 1,thermal_Nsources(ph) call HDF5_write(thermalState(ph)%p(so)%state,groupHandle,'omega_thermal') - enddo + end do end subroutine thermal_restartWrite @@ -292,7 +292,7 @@ module subroutine thermal_restartRead(groupHandle,ph) do so = 1,thermal_Nsources(ph) call HDF5_read(thermalState(ph)%p(so)%state0,groupHandle,'omega_thermal') - enddo + end do end subroutine thermal_restartRead @@ -305,8 +305,8 @@ module subroutine thermal_forward() do ph = 1, size(thermalState) do so = 1, size(thermalState(ph)%p) thermalState(ph)%p(so)%state0 = thermalState(ph)%p(so)%state - enddo - enddo + end do + end do end subroutine thermal_forward @@ -380,8 +380,8 @@ function thermal_active(source_label,src_length) result(active_source) do s = 1, sources%length src => sources%get(s) active_source(s,p) = src%get_asString('type') == source_label - enddo - enddo + end do + end do end function thermal_active diff --git a/src/polynomials.f90 b/src/polynomials.f90 index c883528ca..e04db16f5 100644 --- a/src/polynomials.f90 +++ b/src/polynomials.f90 @@ -112,7 +112,7 @@ pure function eval(self,x) result(y) #else y = IEEE_FMA(y,x-self%x_ref,self%coef(o)) #endif - enddo + end do end function eval diff --git a/src/system_routines.f90 b/src/system_routines.f90 index 209013be4..a74c2e417 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -123,7 +123,7 @@ function getCWD() getCWD = c_f_string(getCWD_Cstring) else error stop 'invalid working directory' - endif + end if end function getCWD @@ -145,7 +145,7 @@ function getHostName() getHostName = c_f_string(getHostName_Cstring) else getHostName = 'n/a (Error!)' - endif + end if end function getHostName From f8833043b341451e73a0d6ccafae9e968c587c36 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 8 Jun 2022 23:15:33 +0200 Subject: [PATCH 39/99] consistent capitalization --- src/results.f90 | 120 ++++++++++++++++++++++++------------------------ 1 file changed, 60 insertions(+), 60 deletions(-) diff --git a/src/results.f90 b/src/results.f90 index bd7f7d34d..cf1b4de5c 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -95,11 +95,11 @@ subroutine results_init(restart) call results_openJobFile call get_command(commandLine) call results_addAttribute('call (restart at '//date//')',trim(commandLine)) - call h5gmove_f(resultsFile,'setup','tmp',hdferr) + call H5Gmove_f(resultsFile,'setup','tmp',hdferr) call results_addAttribute('description','input data used to run the simulation up to restart at '//date,'tmp') call results_closeGroup(results_addGroup('setup')) call results_addAttribute('description','input data used to run the simulation','setup') - call h5gmove_f(resultsFile,'tmp','setup/previous',hdferr) + call H5Gmove_f(resultsFile,'tmp','setup/previous',hdferr) end if call results_closeJobFile @@ -333,8 +333,8 @@ subroutine results_removeLink(link) integer :: hdferr - call h5ldelete_f(resultsFile,link, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'results_removeLink: h5ldelete_soft_f ('//trim(link)//')') + call H5Ldelete_f(resultsFile,link, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg = 'results_removeLink: H5Ldelete_soft_f ('//trim(link)//')') end subroutine results_removeLink @@ -522,7 +522,7 @@ subroutine results_mapping_phase(ID,entry,label) writeSize = 0 writeSize(worldrank) = size(entry(1,:)) ! total number of entries of this process - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + call H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' #ifndef PETSC @@ -530,7 +530,7 @@ subroutine results_mapping_phase(ID,entry,label) #else !-------------------------------------------------------------------------------------------------- ! MPI settings and communication - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if(hdferr < 0) error stop 'HDF5 error' call MPI_Allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get output at each process @@ -558,82 +558,82 @@ subroutine results_mapping_phase(ID,entry,label) !--------------------------------------------------------------------------------------------------- ! compound type: label(ID) + entry - call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr) + call H5Tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr) + call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tget_size_f(dt_id, type_size_string, hdferr) + call H5Tget_size_f(dt_id, type_size_string, hdferr) if(hdferr < 0) error stop 'HDF5 error' pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND) - call h5tget_size_f(pI64_t, type_size_int, hdferr) + call H5Tget_size_f(pI64_t, type_size_int, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr) + call H5Tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr) + call H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tinsert_f(dtype_id, 'entry', type_size_string, pI64_t, hdferr) + call H5Tinsert_f(dtype_id, 'entry', type_size_string, pI64_t, hdferr) if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! create memory types for each component of the compound type - call h5tcreate_f(H5T_COMPOUND_F, type_size_string, label_id, hdferr) + call H5Tcreate_f(H5T_COMPOUND_F, type_size_string, label_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr) + call H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tcreate_f(H5T_COMPOUND_F, type_size_int, entry_id, hdferr) + call H5Tcreate_f(H5T_COMPOUND_F, type_size_int, entry_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tinsert_f(entry_id, 'entry', 0_SIZE_T, pI64_t, hdferr) + call H5Tinsert_f(entry_id, 'entry', 0_SIZE_T, pI64_t, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(dt_id, hdferr) + call H5Tclose_f(dt_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape = hyperslab) and in file (global shape) - call h5screate_simple_f(2,myShape,memspace_id,hdferr,myShape) + call H5Screate_simple_f(2,myShape,memspace_id,hdferr,myShape) if(hdferr < 0) error stop 'HDF5 error' - call h5screate_simple_f(2,totalShape,filespace_id,hdferr,totalShape) + call H5Screate_simple_f(2,totalShape,filespace_id,hdferr,totalShape) if(hdferr < 0) error stop 'HDF5 error' - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr) + call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr) if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! write the components of the compound type individually - call h5pset_preserve_f(plist_id, .true., hdferr) + call H5Pset_preserve_f(plist_id, .true., hdferr) if(hdferr < 0) error stop 'HDF5 error' loc_id = results_openGroup('/cell_to') - call h5dcreate_f(loc_id, 'phase', dtype_id, filespace_id, dset_id, hdferr) + call H5Dcreate_f(loc_id, 'phase', dtype_id, filespace_id, dset_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5dwrite_f(dset_id, label_id, reshape(label(pack(ID,.true.)),myShape), & + call H5Dwrite_f(dset_id, label_id, reshape(label(pack(ID,.true.)),myShape), & myShape, hdferr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if(hdferr < 0) error stop 'HDF5 error' - call h5dwrite_f(dset_id, entry_id, reshape(pack(entryGlobal,.true.),myShape), & + call H5Dwrite_f(dset_id, entry_id, reshape(pack(entryGlobal,.true.),myShape), & myShape, hdferr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! close all call HDF5_closeGroup(loc_id) - call h5pclose_f(plist_id, hdferr) + call H5Pclose_f(plist_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5sclose_f(filespace_id, hdferr) + call H5Sclose_f(filespace_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5sclose_f(memspace_id, hdferr) + call H5Sclose_f(memspace_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5dclose_f(dset_id, hdferr) + call H5Dclose_f(dset_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(dtype_id, hdferr) + call H5Tclose_f(dtype_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(label_id, hdferr) + call H5Tclose_f(label_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(entry_id, hdferr) + call H5Tclose_f(entry_id, hdferr) call executionStamp('cell_to/phase','cell ID and constituent ID to phase results') @@ -678,7 +678,7 @@ subroutine results_mapping_homogenization(ID,entry,label) writeSize = 0 writeSize(worldrank) = size(entry) ! total number of entries of this process - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + call H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' #ifndef PETSC @@ -686,7 +686,7 @@ subroutine results_mapping_homogenization(ID,entry,label) #else !-------------------------------------------------------------------------------------------------- ! MPI settings and communication - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if(hdferr < 0) error stop 'HDF5 error' call MPI_Allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get output at each process @@ -710,82 +710,82 @@ subroutine results_mapping_homogenization(ID,entry,label) !--------------------------------------------------------------------------------------------------- ! compound type: label(ID) + entry - call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr) + call H5Tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr) + call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tget_size_f(dt_id, type_size_string, hdferr) + call H5Tget_size_f(dt_id, type_size_string, hdferr) if(hdferr < 0) error stop 'HDF5 error' pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND) - call h5tget_size_f(pI64_t, type_size_int, hdferr) + call H5Tget_size_f(pI64_t, type_size_int, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr) + call H5Tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr) + call H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tinsert_f(dtype_id, 'entry', type_size_string, pI64_t, hdferr) + call H5Tinsert_f(dtype_id, 'entry', type_size_string, pI64_t, hdferr) if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! create memory types for each component of the compound type - call h5tcreate_f(H5T_COMPOUND_F, type_size_string, label_id, hdferr) + call H5Tcreate_f(H5T_COMPOUND_F, type_size_string, label_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr) + call H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tcreate_f(H5T_COMPOUND_F, type_size_int, entry_id, hdferr) + call H5Tcreate_f(H5T_COMPOUND_F, type_size_int, entry_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tinsert_f(entry_id, 'entry', 0_SIZE_T, pI64_t, hdferr) + call H5Tinsert_f(entry_id, 'entry', 0_SIZE_T, pI64_t, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(dt_id, hdferr) + call H5Tclose_f(dt_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape = hyperslab) and in file (global shape) - call h5screate_simple_f(1,myShape,memspace_id,hdferr,myShape) + call H5Screate_simple_f(1,myShape,memspace_id,hdferr,myShape) if(hdferr < 0) error stop 'HDF5 error' - call h5screate_simple_f(1,totalShape,filespace_id,hdferr,totalShape) + call H5Screate_simple_f(1,totalShape,filespace_id,hdferr,totalShape) if(hdferr < 0) error stop 'HDF5 error' - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr) + call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr) if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! write the components of the compound type individually - call h5pset_preserve_f(plist_id, .true., hdferr) + call H5Pset_preserve_f(plist_id, .true., hdferr) if(hdferr < 0) error stop 'HDF5 error' loc_id = results_openGroup('/cell_to') - call h5dcreate_f(loc_id, 'homogenization', dtype_id, filespace_id, dset_id, hdferr) + call H5Dcreate_f(loc_id, 'homogenization', dtype_id, filespace_id, dset_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5dwrite_f(dset_id, label_id, reshape(label(pack(ID,.true.)),myShape), & + call H5Dwrite_f(dset_id, label_id, reshape(label(pack(ID,.true.)),myShape), & myShape, hdferr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if(hdferr < 0) error stop 'HDF5 error' - call h5dwrite_f(dset_id, entry_id, reshape(pack(entryGlobal,.true.),myShape), & + call H5Dwrite_f(dset_id, entry_id, reshape(pack(entryGlobal,.true.),myShape), & myShape, hdferr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! close all call HDF5_closeGroup(loc_id) - call h5pclose_f(plist_id, hdferr) + call H5Pclose_f(plist_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5sclose_f(filespace_id, hdferr) + call H5Sclose_f(filespace_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5sclose_f(memspace_id, hdferr) + call H5Sclose_f(memspace_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5dclose_f(dset_id, hdferr) + call H5Dclose_f(dset_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(dtype_id, hdferr) + call H5Tclose_f(dtype_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(label_id, hdferr) + call H5Tclose_f(label_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(entry_id, hdferr) + call H5Tclose_f(entry_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' call executionStamp('cell_to/homogenization','cell ID to homogenization results') From 9b94aca09f419d65773911b02f7a8d504b6d5841 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 8 Jun 2022 23:19:05 +0200 Subject: [PATCH 40/99] new example file --- PRIVATE | 2 +- .../plastic/dislotwin_alpha-Brass-shearbanding.yaml | 12 ++++++++++++ 2 files changed, 13 insertions(+), 1 deletion(-) create mode 100644 examples/config/phase/mechanical/plastic/dislotwin_alpha-Brass-shearbanding.yaml diff --git a/PRIVATE b/PRIVATE index 226d7b627..1da271831 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 226d7b627e44247b800bce0d9eb7bef1aac6f537 +Subproject commit 1da271831a4afd0f4a8d46fdbaaf863529fdde06 diff --git a/examples/config/phase/mechanical/plastic/dislotwin_alpha-Brass-shearbanding.yaml b/examples/config/phase/mechanical/plastic/dislotwin_alpha-Brass-shearbanding.yaml new file mode 100644 index 000000000..54f05984f --- /dev/null +++ b/examples/config/phase/mechanical/plastic/dislotwin_alpha-Brass-shearbanding.yaml @@ -0,0 +1,12 @@ +type: dislotwin + +references: + - N. Jia et al., + Acta Materialia 60(3):1099-1115, 2012, + https://doi.org/10.1016/j.actamat.2011.10.047 + +v_sb: 0.0001 +xi_sb: 300.0e6 # tau_hat_sb +Q_sb: 4.0e-19 # Q_0 +p_sb: 1.15 +q_sb: 1.0 From 1ed7bbabefdc6bdb735c27080956649c9d15fc84 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 9 Jun 2022 00:12:19 +0200 Subject: [PATCH 41/99] signal handling etc. not needed here --- .../MarcMentat/apply_DAMASK_modifications.py | 34 ++----------------- 1 file changed, 3 insertions(+), 31 deletions(-) diff --git a/install/MarcMentat/apply_DAMASK_modifications.py b/install/MarcMentat/apply_DAMASK_modifications.py index 473d26da7..208abdd6f 100755 --- a/install/MarcMentat/apply_DAMASK_modifications.py +++ b/install/MarcMentat/apply_DAMASK_modifications.py @@ -6,46 +6,18 @@ import argparse import shutil from pathlib import Path import importlib.machinery -import signal import subprocess import shlex -from functools import partial solver = importlib.machinery.SourceFileLoader( 'damask',f'{str(Path(__file__).parent.absolute().parents[1])}/python/damask/solver/_marc.py').load_module() -def run(cmd, wd='./', env=None, timeout=None): - def pass_signal(sig,_,proc,default): - proc.send_signal(sig) - signal.signal(sig,default) - signal.raise_signal(sig) - signals = [signal.SIGINT,signal.SIGTERM] - print(f"running '{cmd}' in '{wd}'") - process = subprocess.Popen(shlex.split(cmd), - stdout = subprocess.PIPE, - stderr = subprocess.PIPE, - env = os.environ if env is None else env, - cwd = wd, - encoding = 'utf-8') - sig_states = [signal.signal(sig,partial(pass_signal,proc=process,default=signal.getsignal(sig))) for sig in signals] - try: - stdout,stderr = process.communicate(timeout=timeout) - finally: - for sig,state in zip(signals,sig_states): - signal.signal(sig,state) - if process.returncode != 0: - print(stdout) - print(stderr) - raise RuntimeError(f"'{cmd}' failed with returncode {process.returncode}") - return stdout, stderr - - def copy_and_patch(patch,orig,editor): try: shutil.copyfile(orig,orig.parent/patch.stem) except shutil.SameFileError: pass - run(f'patch {orig.parent/patch.stem} {patch} --backup --forward') + subprocess.run(shlex.split(f'patch {orig.parent/patch.stem} {patch} --backup --forward')) with open(orig.parent/patch.stem) as f_in: content = f_in.read() with open(orig.parent/patch.stem,'w') as f_out: @@ -84,7 +56,7 @@ matches = {'Marc_tools': [['comp_user','comp_damask_*mp'], for cmd in ['patch','xvfb-run']: try: - run(f'{cmd} --help') + subprocess.run(shlex.split(f'{cmd} --help')) except FileNotFoundError: print(f'"{cmd}" not found, please install') sys.exit() @@ -103,7 +75,7 @@ print('compiling Mentat menu binaries...') executable = marc_root/f'mentat{marc_version}/bin/mentat' menu_file = marc_root/f'mentat{marc_version}/menus/linux64/main.msb' -run(f'xvfb-run -a {executable} -compile {menu_file}') +subprocess.run(shlex.split(f'xvfb-run -a {executable} -compile {menu_file}')) print('setting file access rights...') From ea6199b9085d6ba5310a6ef866fc2395866ad1c2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 9 Jun 2022 00:22:04 +0200 Subject: [PATCH 42/99] simplified --- install/MarcMentat/apply_DAMASK_modifications.py | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/install/MarcMentat/apply_DAMASK_modifications.py b/install/MarcMentat/apply_DAMASK_modifications.py index 208abdd6f..353df955e 100755 --- a/install/MarcMentat/apply_DAMASK_modifications.py +++ b/install/MarcMentat/apply_DAMASK_modifications.py @@ -1,16 +1,16 @@ #!/usr/bin/env python3 + import os import sys import glob import argparse import shutil from pathlib import Path -import importlib.machinery import subprocess import shlex -solver = importlib.machinery.SourceFileLoader( - 'damask',f'{str(Path(__file__).parent.absolute().parents[1])}/python/damask/solver/_marc.py').load_module() +sys.path.append(str(Path(__file__).parents[2]/'python/damask')) +import solver def copy_and_patch(patch,orig,editor): try: @@ -31,13 +31,13 @@ parser = argparse.ArgumentParser( parser.add_argument('--editor', dest='editor', metavar='string', default='vi', help='Name of the editor (executable) used by Marc Mentat') parser.add_argument('--marc-root', dest='marc_root', metavar='string', - default=solver._marc_root, + default=solver._marc._marc_root, help='Marc root directory') parser.add_argument('--marc-version', dest='marc_version', metavar='string', - default=solver._marc_version, + default=solver._marc._marc_version, help='Marc version') parser.add_argument('--damask-root', dest='damask_root', metavar = 'string', - default=solver._damask_root, + default=solver._marc._damask_root, help='DAMASK root directory') From b3b14e91047e205fecd129e26642287d9cd2628a Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 9 Jun 2022 17:47:00 +0200 Subject: [PATCH 43/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-447-g42ee6310b --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6c99f4893..896507f8b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-442-g49e40923e +3.0.0-alpha6-447-g42ee6310b From 8fefc46f388acc97589b9139dca021c65e5c5dbd Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 9 Jun 2022 16:38:13 -0400 Subject: [PATCH 44/99] fixed FZ conditions and tightened tolerance to accommodate higher precision "tfit" --- python/damask/_orientation.py | 7 +++++-- python/damask/_rotation.py | 25 +++++++++++++++---------- 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/python/damask/_orientation.py b/python/damask/_orientation.py index dcc139b7c..7d6dee3ff 100644 --- a/python/damask/_orientation.py +++ b/python/damask/_orientation.py @@ -448,9 +448,12 @@ class Orientation(Rotation,Crystal): elif self.family == 'orthorhombic': return (np.prod(1. >= rho_abs,axis=-1)).astype(bool) elif self.family == 'monoclinic': - return (1. >= rho_abs[...,1]).astype(bool) + return np.logical_or( 1. >= rho_abs[...,1], + np.isnan(rho_abs[...,1])) + elif self.family == 'triclinic': + return np.ones(rho_abs.shape[:-1]).astype(bool) else: - return np.all(np.isfinite(rho_abs),axis=-1) + raise(TypeError, f'unknown symmetry "{self.family}"') @property diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index 61529eb46..06f87abc5 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -1372,7 +1372,7 @@ class Rotation: w[np.isclose(w[...,0],1.0+0.0j),1:] = 0. w[np.isclose(w[...,1],1.0+0.0j),2:] = 0. vr = np.swapaxes(vr,-1,-2) - ax = np.where(np.abs(diag_delta)<1e-12, + ax = np.where(np.abs(diag_delta)<1e-13, np.real(vr[np.isclose(w,1.0+0.0j)]).reshape(om.shape[:-2]+(3,)), np.abs(np.real(vr[np.isclose(w,1.0+0.0j)]).reshape(om.shape[:-2]+(3,))) \ *np.sign(diag_delta)) @@ -1581,14 +1581,19 @@ class Rotation: @staticmethod def _ho2ax(ho: np.ndarray) -> np.ndarray: """Homochoric vector to axis–angle pair.""" - tfit = np.array([+1.0000000000018852, -0.5000000002194847, - -0.024999992127593126, -0.003928701544781374, - -0.0008152701535450438, -0.0002009500426119712, - -0.00002397986776071756, -0.00008202868926605841, - +0.00012448715042090092, -0.0001749114214822577, - +0.0001703481934140054, -0.00012062065004116828, - +0.000059719705868660826, -0.00001980756723965647, - +0.000003953714684212874, -0.00000036555001439719544]) + tfit = np.array([ + 0.9999999999999968E0, -0.49999999999986866E0, + -0.025000000000632055E0, -0.003928571496460683E0, + -0.0008164666077062752E0, -0.00019411896443261646E0, + -0.00004985822229871769E0, -0.000014164962366386031E0, + -1.9000248160936107E-6, -5.72184549898506E-6, + 7.772149920658778E-6, -0.00001053483452909705E0, + 9.528014229335313E-6, -5.660288876265125E-6, + 1.2844901692764126E-6, 1.1255185726258763E-6, + -1.3834391419956455E-6, 7.513691751164847E-7, + -2.401996891720091E-7, 4.386887017466388E-8, + -3.5917775353564864E-9, + ]) hmag_squared = np.sum(ho**2.,axis=-1,keepdims=True) s = np.sum(tfit*hmag_squared**np.arange(len(tfit)),axis=-1,keepdims=True) with np.errstate(invalid='ignore'): @@ -1679,7 +1684,7 @@ class Rotation: """ with np.errstate(invalid='ignore',divide='ignore'): - # get pyramide and scale by grid parameter ratio + # get pyramid and scale by grid parameter ratio XYZ = np.take_along_axis(cu,Rotation._get_pyramid_order(cu,'forward'),-1) * _sc order = np.abs(XYZ[...,1:2]) <= np.abs(XYZ[...,0:1]) q = np.pi/12.0 * np.where(order,XYZ[...,1:2],XYZ[...,0:1]) \ From d10516e0b6489f7dfdb743bedc07dd7cf857a519 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 9 Jun 2022 17:23:16 -0400 Subject: [PATCH 45/99] fixed typo --- python/damask/_orientation.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/damask/_orientation.py b/python/damask/_orientation.py index 7d6dee3ff..4721143da 100644 --- a/python/damask/_orientation.py +++ b/python/damask/_orientation.py @@ -453,7 +453,7 @@ class Orientation(Rotation,Crystal): elif self.family == 'triclinic': return np.ones(rho_abs.shape[:-1]).astype(bool) else: - raise(TypeError, f'unknown symmetry "{self.family}"') + raise TypeError(f'unknown symmetry "{self.family}"') @property From cdd3b44519e327439d5e7737dfead55f41e1a88e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 9 Jun 2022 23:16:02 +0200 Subject: [PATCH 46/99] using more precise coefficients also in test changes in _rotation.py are just cosmetic --- python/damask/_rotation.py | 20 +++++++------------- python/tests/test_Rotation.py | 15 +++++++-------- 2 files changed, 14 insertions(+), 21 deletions(-) diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index 06f87abc5..f93b3b012 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -1581,19 +1581,13 @@ class Rotation: @staticmethod def _ho2ax(ho: np.ndarray) -> np.ndarray: """Homochoric vector to axis–angle pair.""" - tfit = np.array([ - 0.9999999999999968E0, -0.49999999999986866E0, - -0.025000000000632055E0, -0.003928571496460683E0, - -0.0008164666077062752E0, -0.00019411896443261646E0, - -0.00004985822229871769E0, -0.000014164962366386031E0, - -1.9000248160936107E-6, -5.72184549898506E-6, - 7.772149920658778E-6, -0.00001053483452909705E0, - 9.528014229335313E-6, -5.660288876265125E-6, - 1.2844901692764126E-6, 1.1255185726258763E-6, - -1.3834391419956455E-6, 7.513691751164847E-7, - -2.401996891720091E-7, 4.386887017466388E-8, - -3.5917775353564864E-9, - ]) + tfit = np.array([+0.9999999999999968, -0.49999999999986866, -0.025000000000632055, + -0.003928571496460683, -0.0008164666077062752, -0.00019411896443261646, + -0.00004985822229871769, -0.000014164962366386031, -1.9000248160936107e-6, + -5.72184549898506e-6, +7.772149920658778e-6, -0.00001053483452909705, + +9.528014229335313e-6, -5.660288876265125e-6, +1.2844901692764126e-6, + +1.1255185726258763e-6, -1.3834391419956455e-6, +7.513691751164847e-7, + -2.401996891720091e-7, +4.386887017466388e-8, -3.5917775353564864e-9]) hmag_squared = np.sum(ho**2.,axis=-1,keepdims=True) s = np.sum(tfit*hmag_squared**np.arange(len(tfit)),axis=-1,keepdims=True) with np.errstate(invalid='ignore'): diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index c9dfc68b8..8b1bd0de8 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -301,14 +301,13 @@ def ro2ho(ro): #---------- Homochoric vector---------- def ho2ax(ho): """Homochoric vector to axis angle pair.""" - tfit = np.array([+1.0000000000018852, -0.5000000002194847, - -0.024999992127593126, -0.003928701544781374, - -0.0008152701535450438, -0.0002009500426119712, - -0.00002397986776071756, -0.00008202868926605841, - +0.00012448715042090092, -0.0001749114214822577, - +0.0001703481934140054, -0.00012062065004116828, - +0.000059719705868660826, -0.00001980756723965647, - +0.000003953714684212874, -0.00000036555001439719544]) + tfit = np.array([+0.9999999999999968, -0.49999999999986866, -0.025000000000632055, + -0.003928571496460683, -0.0008164666077062752, -0.00019411896443261646, + -0.00004985822229871769, -0.000014164962366386031, -1.9000248160936107e-6, + -5.72184549898506e-6, +7.772149920658778e-6, -0.00001053483452909705, + +9.528014229335313e-6, -5.660288876265125e-6, +1.2844901692764126e-6, + +1.1255185726258763e-6, -1.3834391419956455e-6, +7.513691751164847e-7, + -2.401996891720091e-7, +4.386887017466388e-8, -3.5917775353564864e-9]) # normalize h and store the magnitude hmag_squared = np.sum(ho**2.) if iszero(hmag_squared): From bcd3d00960511dd140cfac3b92a3eede7b24d947 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 9 Jun 2022 23:28:04 +0200 Subject: [PATCH 47/99] fixed test this tests should ensure that each Orientation has exactly one symmetrically equivalent representation. It was not fully correct before and works as expected after 8fefc46f388acc97589b9139dca021c65e5c5dbd --- python/tests/test_Orientation.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/python/tests/test_Orientation.py b/python/tests/test_Orientation.py index 5f9b83e70..2cb97d252 100644 --- a/python/tests/test_Orientation.py +++ b/python/tests/test_Orientation.py @@ -224,11 +224,11 @@ class TestOrientation: @pytest.mark.parametrize('family',crystal_families) def test_reduced_corner_cases(self,family): - # test whether there is always a sym-eq rotation that falls into the FZ + # test whether there is always exactly one sym-eq rotation that falls into the FZ N = np.random.randint(10,40) size = np.ones(3)*np.pi**(2./3.) grid = grid_filters.coordinates0_node([N+1,N+1,N+1],size,-size*.5) - evenly_distributed = Orientation.from_cubochoric(x=grid[:-2,:-2,:-2],family=family) + evenly_distributed = Orientation.from_cubochoric(x=grid,family=family) assert evenly_distributed.shape == evenly_distributed.reduced.shape @pytest.mark.parametrize('family',crystal_families) From afbafd1d981479d8d4584909c87ce20401f7791f Mon Sep 17 00:00:00 2001 From: "d.mentock" Date: Fri, 10 Jun 2022 12:00:54 +0200 Subject: [PATCH 48/99] util imports need prefix instead of __all__ definition to prevent namespace pollution --- python/damask/util.py | 238 +++++++++++++++++++----------------------- 1 file changed, 110 insertions(+), 128 deletions(-) diff --git a/python/damask/util.py b/python/damask/util.py index ab3789bf5..468ac49ec 100644 --- a/python/damask/util.py +++ b/python/damask/util.py @@ -1,43 +1,25 @@ """Miscellaneous helper functionality.""" -import sys -import datetime -import os -import subprocess -import shlex -import re -import signal -import fractions -from collections import abc -from functools import reduce, partial -from typing import Callable, Union, Iterable, Sequence, Dict, List, Tuple, Literal, Any, Collection, TextIO -from pathlib import Path +import sys as _sys +import datetime as _datetime +import os as _os +import subprocess as _subprocess +import shlex as _shlex +import re as _re +import signal as _signal +import fractions as _fractions +from collections import abc as _abc +from functools import reduce as _reduce, partial as _partial +from typing import Callable as _Callable, Union as _Union, Iterable as _Iterable, Sequence as _Sequence, Dict as _Dict, \ + List as _List, Tuple as _Tuple, Literal as _Literal, Any as _Any, Collection as _Collection, TextIO as _TextIO +from pathlib import Path as _Path -import numpy as np -import h5py +import numpy as _np +import h5py as _h5py -from . import version -from ._typehints import FloatSequence, NumpyRngSeed, IntCollection, FileHandle - -# limit visibility -__all__=[ - 'srepr', - 'emph', 'deemph', 'warn', 'strikeout', - 'run', - 'open_text', - 'natural_sort', - 'show_progress', - 'scale_to_coprime', - 'project_equal_angle', 'project_equal_area', - 'hybrid_IA', - 'execution_stamp', - 'shapeshifter', 'shapeblender', - 'extend_docstring', 'extended_docstring', - 'Bravais_to_Miller', 'Miller_to_Bravais', - 'DREAM3D_base_group', 'DREAM3D_cell_data_group', - 'dict_prune', 'dict_flatten', - 'tail_repack', - ] +from . import version as _version +from ._typehints import FloatSequence as _FloatSequence, NumpyRngSeed as _NumpyRngSeed, IntCollection as _IntCollection, \ + FileHandle as _FileHandle # https://svn.blender.org/svnroot/bf-blender/trunk/blender/build_files/scons/tools/bcolors.py # https://stackoverflow.com/questions/287871 @@ -154,8 +136,8 @@ def strikeout(msg) -> str: def run(cmd: str, wd: str = './', - env: Dict[str, str] = None, - timeout: int = None) -> Tuple[str, str]: + env: _Dict[str, str] = None, + timeout: int = None) -> _Tuple[str, str]: """ Run a command. @@ -178,26 +160,26 @@ def run(cmd: str, """ def pass_signal(sig,_,proc,default): proc.send_signal(sig) - signal.signal(sig,default) - signal.raise_signal(sig) + _signal.signal(sig,default) + _signal.raise_signal(sig) - signals = [signal.SIGINT,signal.SIGTERM] + signals = [_signal.SIGINT,_signal.SIGTERM] print(f"running '{cmd}' in '{wd}'") - process = subprocess.Popen(shlex.split(cmd), - stdout = subprocess.PIPE, - stderr = subprocess.PIPE, - env = os.environ if env is None else env, + process = _subprocess.Popen(_shlex.split(cmd), + stdout = _subprocess.PIPE, + stderr = _subprocess.PIPE, + env = _os.environ if env is None else env, cwd = wd, encoding = 'utf-8') # ensure that process is terminated (https://stackoverflow.com/questions/22916783) - sig_states = [signal.signal(sig,partial(pass_signal,proc=process,default=signal.getsignal(sig))) for sig in signals] + sig_states = [_signal.signal(sig,_partial(pass_signal,proc=process,default=_signal.getsignal(sig))) for sig in signals] try: stdout,stderr = process.communicate(timeout=timeout) finally: for sig,state in zip(signals,sig_states): - signal.signal(sig,state) + _signal.signal(sig,state) if process.returncode != 0: print(stdout) @@ -207,8 +189,8 @@ def run(cmd: str, return stdout, stderr -def open_text(fname: FileHandle, - mode: Literal['r','w'] = 'r') -> TextIO: +def open_text(fname: _FileHandle, + mode: _Literal['r','w'] = 'r') -> _TextIO: """ Open a text file. @@ -224,11 +206,11 @@ def open_text(fname: FileHandle, f : file handle """ - return fname if not isinstance(fname, (str,Path)) else \ - open(Path(fname).expanduser(),mode,newline=('\n' if mode == 'w' else None)) + return fname if not isinstance(fname, (str,_Path)) else \ + open(_Path(fname).expanduser(),mode,newline=('\n' if mode == 'w' else None)) -def natural_sort(key: str) -> List[Union[int, str]]: +def natural_sort(key: str) -> _List[_Union[int, str]]: """ Natural sort. @@ -240,13 +222,13 @@ def natural_sort(key: str) -> List[Union[int, str]]: """ convert = lambda text: int(text) if text.isdigit() else text - return [ convert(c) for c in re.split('([0-9]+)', key) ] + return [ convert(c) for c in _re.split('([0-9]+)', key) ] -def show_progress(iterable: Iterable, +def show_progress(iterable: _Iterable, N_iter: int = None, prefix: str = '', - bar_length: int = 50) -> Any: + bar_length: int = 50) -> _Any: """ Decorate a loop with a progress bar. @@ -264,7 +246,7 @@ def show_progress(iterable: Iterable, Length of progress bar in characters. Defaults to 50. """ - if isinstance(iterable,abc.Sequence): + if isinstance(iterable,_abc.Sequence): if N_iter is None: N = len(iterable) else: @@ -285,7 +267,7 @@ def show_progress(iterable: Iterable, status.update(i) -def scale_to_coprime(v: FloatSequence) -> np.ndarray: +def scale_to_coprime(v: _FloatSequence) -> _np.ndarray: """ Scale vector to co-prime (relatively prime) integers. @@ -304,30 +286,30 @@ def scale_to_coprime(v: FloatSequence) -> np.ndarray: def get_square_denominator(x): """Denominator of the square of a number.""" - return fractions.Fraction(x ** 2).limit_denominator(MAX_DENOMINATOR).denominator + return _fractions.Fraction(x ** 2).limit_denominator(MAX_DENOMINATOR).denominator def lcm(a,b): """Least common multiple.""" try: - return np.lcm(a,b) # numpy > 1.18 + return _np.lcm(a,b) # numpy > 1.18 except AttributeError: - return a * b // np.gcd(a, b) + return a * b // _np.gcd(a, b) - v_ = np.array(v) - m = (v_ * reduce(lcm, map(lambda x: int(get_square_denominator(x)),v_))**0.5).astype(np.int64) - m = m//reduce(np.gcd,m) + v_ = _np.array(v) + m = (v_ * _reduce(lcm, map(lambda x: int(get_square_denominator(x)),v_))**0.5).astype(_np.int64) + m = m//_reduce(_np.gcd,m) - with np.errstate(invalid='ignore'): - if not np.allclose(np.ma.masked_invalid(v_/m),v_[np.argmax(abs(v_))]/m[np.argmax(abs(v_))]): + with _np.errstate(invalid='ignore'): + if not _np.allclose(_np.ma.masked_invalid(v_/m),v_[_np.argmax(abs(v_))]/m[_np.argmax(abs(v_))]): raise ValueError(f'invalid result "{m}" for input "{v_}"') return m -def project_equal_angle(vector: np.ndarray, - direction: Literal['x', 'y', 'z'] = 'z', +def project_equal_angle(vector: _np.ndarray, + direction: _Literal['x', 'y', 'z'] = 'z', normalize: bool = True, - keepdims: bool = False) -> np.ndarray: + keepdims: bool = False) -> _np.ndarray: """ Apply equal-angle projection to vector. @@ -367,15 +349,15 @@ def project_equal_angle(vector: np.ndarray, """ shift = 'zyx'.index(direction) - v = np.roll(vector/np.linalg.norm(vector,axis=-1,keepdims=True) if normalize else vector, + v = _np.roll(vector/_np.linalg.norm(vector,axis=-1,keepdims=True) if normalize else vector, shift,axis=-1) - return np.roll(np.block([v[...,:2]/(1.0+np.abs(v[...,2:3])),np.zeros_like(v[...,2:3])]), + return _np.roll(_np.block([v[...,:2]/(1.0+_np.abs(v[...,2:3])),_np.zeros_like(v[...,2:3])]), -shift if keepdims else 0,axis=-1)[...,:3 if keepdims else 2] -def project_equal_area(vector: np.ndarray, - direction: Literal['x', 'y', 'z'] = 'z', +def project_equal_area(vector: _np.ndarray, + direction: _Literal['x', 'y', 'z'] = 'z', normalize: bool = True, - keepdims: bool = False) -> np.ndarray: + keepdims: bool = False) -> _np.ndarray: """ Apply equal-area projection to vector. @@ -416,22 +398,22 @@ def project_equal_area(vector: np.ndarray, """ shift = 'zyx'.index(direction) - v = np.roll(vector/np.linalg.norm(vector,axis=-1,keepdims=True) if normalize else vector, + v = _np.roll(vector/_np.linalg.norm(vector,axis=-1,keepdims=True) if normalize else vector, shift,axis=-1) - return np.roll(np.block([v[...,:2]/np.sqrt(1.0+np.abs(v[...,2:3])),np.zeros_like(v[...,2:3])]), + return _np.roll(_np.block([v[...,:2]/_np.sqrt(1.0+_np.abs(v[...,2:3])),_np.zeros_like(v[...,2:3])]), -shift if keepdims else 0,axis=-1)[...,:3 if keepdims else 2] def execution_stamp(class_name: str, function_name: str = None) -> str: """Timestamp the execution of a (function within a) class.""" - now = datetime.datetime.now().astimezone().strftime('%Y-%m-%d %H:%M:%S%z') + now = _datetime.datetime.now().astimezone().strftime('%Y-%m-%d %H:%M:%S%z') _function_name = '' if function_name is None else f'.{function_name}' - return f'damask.{class_name}{_function_name} v{version} ({now})' + return f'damask.{class_name}{_function_name} v{_version} ({now})' -def hybrid_IA(dist: np.ndarray, +def hybrid_IA(dist: _np.ndarray, N: int, - rng_seed: NumpyRngSeed = None) -> np.ndarray: + rng_seed: _NumpyRngSeed = None) -> _np.ndarray: """ Hybrid integer approximation. @@ -446,23 +428,23 @@ def hybrid_IA(dist: np.ndarray, If None, then fresh, unpredictable entropy will be pulled from the OS. """ - N_opt_samples,N_inv_samples = (max(np.count_nonzero(dist),N),0) # random subsampling if too little samples requested + N_opt_samples,N_inv_samples = (max(_np.count_nonzero(dist),N),0) # random subsampling if too little samples requested scale_,scale,inc_factor = (0.0,float(N_opt_samples),1.0) - while (not np.isclose(scale, scale_)) and (N_inv_samples != N_opt_samples): - repeats = np.rint(scale*dist).astype(np.int64) - N_inv_samples = np.sum(repeats) + while (not _np.isclose(scale, scale_)) and (N_inv_samples != N_opt_samples): + repeats = _np.rint(scale*dist).astype(_np.int64) + N_inv_samples = _np.sum(repeats) scale_,scale,inc_factor = (scale,scale+inc_factor*0.5*(scale - scale_), inc_factor*2.0) \ if N_inv_samples < N_opt_samples else \ (scale_,0.5*(scale_ + scale), 1.0) - return np.repeat(np.arange(len(dist)),repeats)[np.random.default_rng(rng_seed).permutation(N_inv_samples)[:N]] + return _np.repeat(_np.arange(len(dist)),repeats)[_np.random.default_rng(rng_seed).permutation(N_inv_samples)[:N]] -def shapeshifter(fro: Tuple[int, ...], - to: Tuple[int, ...], - mode: Literal['left','right'] = 'left', - keep_ones: bool = False) -> Tuple[int, ...]: +def shapeshifter(fro: _Tuple[int, ...], + to: _Tuple[int, ...], + mode: _Literal['left','right'] = 'left', + keep_ones: bool = False) -> _Tuple[int, ...]: """ Return dimensions that reshape 'fro' to become broadcastable to 'to'. @@ -509,7 +491,7 @@ def shapeshifter(fro: Tuple[int, ...], fro = (1,) if len(fro) == 0 else fro to = (1,) if len(to) == 0 else to try: - match = re.match(beg[mode] + match = _re.match(beg[mode] +f',{sep[mode]}'.join(map(lambda x: f'{x}' if x>1 or (keep_ones and len(fro)>1) else '\\d+',fro)) @@ -518,14 +500,14 @@ def shapeshifter(fro: Tuple[int, ...], grp = match.groups() except AssertionError: raise ValueError(f'shapes cannot be shifted {fro} --> {to}') - fill: Any = () + fill: _Any = () for g,d in zip(grp,fro+(None,)): fill += (1,)*g.count(',')+(d,) return fill[:-1] -def shapeblender(a: Tuple[int, ...], - b: Tuple[int, ...]) -> Tuple[int, ...]: +def shapeblender(a: _Tuple[int, ...], + b: _Tuple[int, ...]) -> _Tuple[int, ...]: """ Return a shape that overlaps the rightmost entries of 'a' with the leftmost of 'b'. @@ -553,7 +535,7 @@ def shapeblender(a: Tuple[int, ...], return a + b[i:] -def extend_docstring(extra_docstring: str) -> Callable: +def extend_docstring(extra_docstring: str) -> _Callable: """ Decorator: Append to function's docstring. @@ -569,8 +551,8 @@ def extend_docstring(extra_docstring: str) -> Callable: return _decorator -def extended_docstring(f: Callable, - extra_docstring: str) -> Callable: +def extended_docstring(f: _Callable, + extra_docstring: str) -> _Callable: """ Decorator: Combine another function's docstring with a given docstring. @@ -588,7 +570,7 @@ def extended_docstring(f: Callable, return _decorator -def DREAM3D_base_group(fname: Union[str, Path]) -> str: +def DREAM3D_base_group(fname: _Union[str, _Path]) -> str: """ Determine the base group of a DREAM.3D file. @@ -606,7 +588,7 @@ def DREAM3D_base_group(fname: Union[str, Path]) -> str: Path to the base group. """ - with h5py.File(Path(fname).expanduser(),'r') as f: + with _h5py.File(_Path(fname).expanduser(),'r') as f: base_group = f.visit(lambda path: path.rsplit('/',2)[0] if '_SIMPL_GEOMETRY/SPACING' in path else None) if base_group is None: @@ -614,7 +596,7 @@ def DREAM3D_base_group(fname: Union[str, Path]) -> str: return base_group -def DREAM3D_cell_data_group(fname: Union[str, Path]) -> str: +def DREAM3D_cell_data_group(fname: _Union[str, _Path]) -> str: """ Determine the cell data group of a DREAM.3D file. @@ -634,10 +616,10 @@ def DREAM3D_cell_data_group(fname: Union[str, Path]) -> str: """ base_group = DREAM3D_base_group(fname) - with h5py.File(Path(fname).expanduser(),'r') as f: + with _h5py.File(_Path(fname).expanduser(),'r') as f: cells = tuple(f['/'.join([base_group,'_SIMPL_GEOMETRY','DIMENSIONS'])][()][::-1]) cell_data_group = f[base_group].visititems(lambda path,obj: path.split('/')[0] \ - if isinstance(obj,h5py._hl.dataset.Dataset) and np.shape(obj)[:-1] == cells \ + if isinstance(obj,_h5py._hl.dataset.Dataset) and _np.shape(obj)[:-1] == cells \ else None) if cell_data_group is None: @@ -647,8 +629,8 @@ def DREAM3D_cell_data_group(fname: Union[str, Path]) -> str: def Bravais_to_Miller(*, - uvtw: np.ndarray = None, - hkil: np.ndarray = None) -> np.ndarray: + uvtw: _np.ndarray = None, + hkil: _np.ndarray = None) -> _np.ndarray: """ Transform 4 Miller–Bravais indices to 3 Miller indices of crystal direction [uvw] or plane normal (hkl). @@ -665,19 +647,19 @@ def Bravais_to_Miller(*, """ if (uvtw is not None) ^ (hkil is None): raise KeyError('specify either "uvtw" or "hkil"') - axis,basis = (np.array(uvtw),np.array([[1,0,-1,0], + axis,basis = (_np.array(uvtw),_np.array([[1,0,-1,0], [0,1,-1,0], [0,0, 0,1]])) \ if hkil is None else \ - (np.array(hkil),np.array([[1,0,0,0], + (_np.array(hkil),_np.array([[1,0,0,0], [0,1,0,0], [0,0,0,1]])) - return np.einsum('il,...l',basis,axis) + return _np.einsum('il,...l',basis,axis) def Miller_to_Bravais(*, - uvw: np.ndarray = None, - hkl: np.ndarray = None) -> np.ndarray: + uvw: _np.ndarray = None, + hkl: _np.ndarray = None) -> _np.ndarray: """ Transform 3 Miller indices to 4 Miller–Bravais indices of crystal direction [uvtw] or plane normal (hkil). @@ -694,19 +676,19 @@ def Miller_to_Bravais(*, """ if (uvw is not None) ^ (hkl is None): raise KeyError('specify either "uvw" or "hkl"') - axis,basis = (np.array(uvw),np.array([[ 2,-1, 0], + axis,basis = (_np.array(uvw),_np.array([[ 2,-1, 0], [-1, 2, 0], [-1,-1, 0], [ 0, 0, 3]])/3) \ if hkl is None else \ - (np.array(hkl),np.array([[ 1, 0, 0], + (_np.array(hkl),_np.array([[ 1, 0, 0], [ 0, 1, 0], [-1,-1, 0], [ 0, 0, 1]])) - return np.einsum('il,...l',basis,axis) + return _np.einsum('il,...l',basis,axis) -def dict_prune(d: Dict) -> Dict: +def dict_prune(d: _Dict) -> _Dict: """ Recursively remove empty dictionaries. @@ -732,7 +714,7 @@ def dict_prune(d: Dict) -> Dict: return new -def dict_flatten(d: Dict) -> Dict: +def dict_flatten(d: _Dict) -> _Dict: """ Recursively remove keys of single-entry dictionaries. @@ -756,8 +738,8 @@ def dict_flatten(d: Dict) -> Dict: return new -def tail_repack(extended: Union[str, Sequence[str]], - existing: List[str] = []) -> List[str]: +def tail_repack(extended: _Union[str, _Sequence[str]], + existing: _List[str] = []) -> _List[str]: """ Repack tailing characters into single string if all are new. @@ -782,11 +764,11 @@ def tail_repack(extended: Union[str, Sequence[str]], """ return [extended] if isinstance(extended,str) else existing + \ - ([''.join(extended[len(existing):])] if np.prod([len(i) for i in extended[len(existing):]]) == 1 else + ([''.join(extended[len(existing):])] if _np.prod([len(i) for i in extended[len(existing):]]) == 1 else list(extended[len(existing):])) -def aslist(arg: Union[IntCollection,int,None]) -> List: +def aslist(arg: _Union[_IntCollection, int, None]) -> _List: """ Transform argument to list. @@ -801,7 +783,7 @@ def aslist(arg: Union[IntCollection,int,None]) -> List: Entity transformed into list. """ - return [] if arg is None else list(arg) if isinstance(arg,(np.ndarray,Collection)) else [arg] + return [] if arg is None else list(arg) if isinstance(arg,(_np.ndarray,_Collection)) else [arg] #################################################################################################### @@ -834,11 +816,11 @@ class ProgressBar: self.total = total self.prefix = prefix self.bar_length = bar_length - self.time_start = self.time_last_update = datetime.datetime.now() + self.time_start = self.time_last_update = _datetime.datetime.now() self.fraction_last = 0.0 - sys.stderr.write(f"{self.prefix} {'░'*self.bar_length} 0% ETA n/a") - sys.stderr.flush() + _sys.stderr.write(f"{self.prefix} {'░'*self.bar_length} 0% ETA n/a") + _sys.stderr.flush() def update(self, iteration: int) -> None: @@ -846,17 +828,17 @@ class ProgressBar: fraction = (iteration+1) / self.total if (filled_length := int(self.bar_length * fraction)) > int(self.bar_length * self.fraction_last) or \ - datetime.datetime.now() - self.time_last_update > datetime.timedelta(seconds=10): - self.time_last_update = datetime.datetime.now() + _datetime.datetime.now() - self.time_last_update > _datetime.timedelta(seconds=10): + self.time_last_update = _datetime.datetime.now() bar = '█' * filled_length + '░' * (self.bar_length - filled_length) - remaining_time = (datetime.datetime.now() - self.time_start) \ + remaining_time = (_datetime.datetime.now() - self.time_start) \ * (self.total - (iteration+1)) / (iteration+1) - remaining_time -= datetime.timedelta(microseconds=remaining_time.microseconds) # remove μs - sys.stderr.write(f'\r{self.prefix} {bar} {fraction:>4.0%} ETA {remaining_time}') - sys.stderr.flush() + remaining_time -= _datetime.timedelta(microseconds=remaining_time.microseconds) # remove μs + _sys.stderr.write(f'\r{self.prefix} {bar} {fraction:>4.0%} ETA {remaining_time}') + _sys.stderr.flush() self.fraction_last = fraction if iteration == self.total - 1: - sys.stderr.write('\n') - sys.stderr.flush() + _sys.stderr.write('\n') + _sys.stderr.flush() From d88a139a41b0b47d9c0c242d181a1c0d5c3c6e39 Mon Sep 17 00:00:00 2001 From: "d.mentock" Date: Fri, 10 Jun 2022 12:03:50 +0200 Subject: [PATCH 49/99] pyflakes bug causes error without comment --- python/damask/util.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/python/damask/util.py b/python/damask/util.py index 468ac49ec..5e003bb7e 100644 --- a/python/damask/util.py +++ b/python/damask/util.py @@ -190,7 +190,7 @@ def run(cmd: str, def open_text(fname: _FileHandle, - mode: _Literal['r','w'] = 'r') -> _TextIO: + mode: _Literal['r','w'] = 'r') -> _TextIO: # noqa """ Open a text file. @@ -307,7 +307,7 @@ def scale_to_coprime(v: _FloatSequence) -> _np.ndarray: def project_equal_angle(vector: _np.ndarray, - direction: _Literal['x', 'y', 'z'] = 'z', + direction: _Literal['x', 'y', 'z'] = 'z', # noqa normalize: bool = True, keepdims: bool = False) -> _np.ndarray: """ @@ -355,7 +355,7 @@ def project_equal_angle(vector: _np.ndarray, -shift if keepdims else 0,axis=-1)[...,:3 if keepdims else 2] def project_equal_area(vector: _np.ndarray, - direction: _Literal['x', 'y', 'z'] = 'z', + direction: _Literal['x', 'y', 'z'] = 'z', # noqa normalize: bool = True, keepdims: bool = False) -> _np.ndarray: """ @@ -443,7 +443,7 @@ def hybrid_IA(dist: _np.ndarray, def shapeshifter(fro: _Tuple[int, ...], to: _Tuple[int, ...], - mode: _Literal['left','right'] = 'left', + mode: _Literal['left','right'] = 'left', # noqa keep_ones: bool = False) -> _Tuple[int, ...]: """ Return dimensions that reshape 'fro' to become broadcastable to 'to'. From 1a44b6e692b363ce4ae479ef6a68b849ec308525 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 10 Jun 2022 14:03:43 +0200 Subject: [PATCH 50/99] white space adjustments --- python/damask/util.py | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/python/damask/util.py b/python/damask/util.py index 5e003bb7e..f6d67fb37 100644 --- a/python/damask/util.py +++ b/python/damask/util.py @@ -167,11 +167,11 @@ def run(cmd: str, print(f"running '{cmd}' in '{wd}'") process = _subprocess.Popen(_shlex.split(cmd), - stdout = _subprocess.PIPE, - stderr = _subprocess.PIPE, - env = _os.environ if env is None else env, - cwd = wd, - encoding = 'utf-8') + stdout = _subprocess.PIPE, + stderr = _subprocess.PIPE, + env = _os.environ if env is None else env, + cwd = wd, + encoding = 'utf-8') # ensure that process is terminated (https://stackoverflow.com/questions/22916783) sig_states = [_signal.signal(sig,_partial(pass_signal,proc=process,default=_signal.getsignal(sig))) for sig in signals] @@ -350,9 +350,9 @@ def project_equal_angle(vector: _np.ndarray, """ shift = 'zyx'.index(direction) v = _np.roll(vector/_np.linalg.norm(vector,axis=-1,keepdims=True) if normalize else vector, - shift,axis=-1) + shift,axis=-1) return _np.roll(_np.block([v[...,:2]/(1.0+_np.abs(v[...,2:3])),_np.zeros_like(v[...,2:3])]), - -shift if keepdims else 0,axis=-1)[...,:3 if keepdims else 2] + -shift if keepdims else 0,axis=-1)[...,:3 if keepdims else 2] def project_equal_area(vector: _np.ndarray, direction: _Literal['x', 'y', 'z'] = 'z', # noqa @@ -399,9 +399,9 @@ def project_equal_area(vector: _np.ndarray, """ shift = 'zyx'.index(direction) v = _np.roll(vector/_np.linalg.norm(vector,axis=-1,keepdims=True) if normalize else vector, - shift,axis=-1) + shift,axis=-1) return _np.roll(_np.block([v[...,:2]/_np.sqrt(1.0+_np.abs(v[...,2:3])),_np.zeros_like(v[...,2:3])]), - -shift if keepdims else 0,axis=-1)[...,:3 if keepdims else 2] + -shift if keepdims else 0,axis=-1)[...,:3 if keepdims else 2] def execution_stamp(class_name: str, function_name: str = None) -> str: @@ -648,12 +648,12 @@ def Bravais_to_Miller(*, if (uvtw is not None) ^ (hkil is None): raise KeyError('specify either "uvtw" or "hkil"') axis,basis = (_np.array(uvtw),_np.array([[1,0,-1,0], - [0,1,-1,0], - [0,0, 0,1]])) \ + [0,1,-1,0], + [0,0, 0,1]])) \ if hkil is None else \ (_np.array(hkil),_np.array([[1,0,0,0], - [0,1,0,0], - [0,0,0,1]])) + [0,1,0,0], + [0,0,0,1]])) return _np.einsum('il,...l',basis,axis) @@ -677,14 +677,14 @@ def Miller_to_Bravais(*, if (uvw is not None) ^ (hkl is None): raise KeyError('specify either "uvw" or "hkl"') axis,basis = (_np.array(uvw),_np.array([[ 2,-1, 0], - [-1, 2, 0], - [-1,-1, 0], - [ 0, 0, 3]])/3) \ + [-1, 2, 0], + [-1,-1, 0], + [ 0, 0, 3]])/3) \ if hkl is None else \ (_np.array(hkl),_np.array([[ 1, 0, 0], - [ 0, 1, 0], - [-1,-1, 0], - [ 0, 0, 1]])) + [ 0, 1, 0], + [-1,-1, 0], + [ 0, 0, 1]])) return _np.einsum('il,...l',basis,axis) From bbd4f01fb782d55cd8914dd2da89a66a0a4c5aaa Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 11 Jun 2022 03:24:31 +0200 Subject: [PATCH 51/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-453-g98b307f0c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 896507f8b..104caef74 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-447-g42ee6310b +3.0.0-alpha6-453-g98b307f0c From 9e0a0ee166b85a13e580448b1f2c0c6fad4f82c8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 11 Jun 2022 23:04:21 +0200 Subject: [PATCH 52/99] not needed --- src/rotations.f90 | 676 +--------------------------------------------- 1 file changed, 10 insertions(+), 666 deletions(-) diff --git a/src/rotations.f90 b/src/rotations.f90 index 5367f2c07..7e0d33cff 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -61,7 +61,6 @@ module rotations procedure, public :: asQuaternion procedure, public :: asEulers procedure, public :: asAxisAngle - procedure, public :: asRodrigues procedure, public :: asMatrix !------------------------------------------ procedure, public :: fromQuaternion @@ -150,24 +149,7 @@ pure function asMatrix(self) asMatrix = qu2om(self%q) end function asMatrix -!--------------------------------------------------------------------------------------------------- -pure function asRodrigues(self) - class(tRotation), intent(in) :: self - real(pReal), dimension(4) :: asRodrigues - - asRodrigues = qu2ro(self%q) - -end function asRodrigues -!--------------------------------------------------------------------------------------------------- -pure function asHomochoric(self) - - class(tRotation), intent(in) :: self - real(pReal), dimension(3) :: asHomochoric - - asHomochoric = qu2ho(self%q) - -end function asHomochoric !--------------------------------------------------------------------------------------------------- ! Initialize rotation from different representations @@ -508,71 +490,6 @@ pure function qu2ax(qu) result(ax) end function qu2ax -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert unit quaternion to Rodrigues vector -!--------------------------------------------------------------------------------------------------- -pure function qu2ro(qu) result(ro) - - real(pReal), intent(in), dimension(4) :: qu - real(pReal), dimension(4) :: ro - - real(pReal) :: s - real(pReal), parameter :: thr = 1.0e-8_pReal - - if (abs(qu(1)) < thr) then - ro = [qu(2), qu(3), qu(4), IEEE_value(1.0_pReal,IEEE_positive_inf)] - else - s = norm2(qu(2:4)) - if (s < thr) then - ro = [0.0_pReal, 0.0_pReal, P, 0.0_pReal] - else - ro = [qu(2)/s,qu(3)/s,qu(4)/s, tan(acos(math_clip(qu(1),-1.0_pReal,1.0_pReal)))] - endif - - end if - -end function qu2ro - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert unit quaternion to homochoric -!--------------------------------------------------------------------------------------------------- -pure function qu2ho(qu) result(ho) - - real(pReal), intent(in), dimension(4) :: qu - real(pReal), dimension(3) :: ho - - real(pReal) :: omega, f - - omega = 2.0 * acos(math_clip(qu(1),-1.0_pReal,1.0_pReal)) - - if (dEq0(omega,tol=1.e-5_pReal)) then - ho = [ 0.0_pReal, 0.0_pReal, 0.0_pReal ] - else - ho = qu(2:4) - f = 0.75_pReal * ( omega - sin(omega) ) - ho = ho/norm2(ho)* f**(1.0_pReal/3.0_pReal) - end if - -end function qu2ho - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert unit quaternion to cubochoric -!--------------------------------------------------------------------------------------------------- -pure function qu2cu(qu) result(cu) - - real(pReal), intent(in), dimension(4) :: qu - real(pReal), dimension(3) :: cu - - cu = ho2cu(qu2ho(qu)) - -end function qu2cu - - !--------------------------------------------------------------------------------------------------- !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief convert rotation matrix to unit quaternion @@ -669,48 +586,6 @@ function om2ax(om) result(ax) end function om2ax -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert rotation matrix to Rodrigues vector -!--------------------------------------------------------------------------------------------------- -pure function om2ro(om) result(ro) - - real(pReal), intent(in), dimension(3,3) :: om - real(pReal), dimension(4) :: ro - - ro = eu2ro(om2eu(om)) - -end function om2ro - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert rotation matrix to homochoric -!--------------------------------------------------------------------------------------------------- -function om2ho(om) result(ho) - - real(pReal), intent(in), dimension(3,3) :: om - real(pReal), dimension(3) :: ho - - ho = ax2ho(om2ax(om)) - -end function om2ho - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert rotation matrix to cubochoric -!--------------------------------------------------------------------------------------------------- -function om2cu(om) result(cu) - - real(pReal), intent(in), dimension(3,3) :: om - real(pReal), dimension(3) :: cu - - cu = ho2cu(om2ho(om)) - -end function om2cu - - !--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @brief Euler angles to unit quaternion @@ -794,55 +669,6 @@ pure function eu2ax(eu) result(ax) end function eu2ax -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief Euler angles to Rodrigues vector -!--------------------------------------------------------------------------------------------------- -pure function eu2ro(eu) result(ro) - - real(pReal), intent(in), dimension(3) :: eu - real(pReal), dimension(4) :: ro - - ro = eu2ax(eu) - if (ro(4) >= PI) then - ro(4) = IEEE_value(ro(4),IEEE_positive_inf) - elseif(dEq0(ro(4))) then - ro = [ 0.0_pReal, 0.0_pReal, P, 0.0_pReal ] - else - ro(4) = tan(ro(4)*0.5_pReal) - end if - -end function eu2ro - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert Euler angles to homochoric -!--------------------------------------------------------------------------------------------------- -pure function eu2ho(eu) result(ho) - - real(pReal), intent(in), dimension(3) :: eu - real(pReal), dimension(3) :: ho - - ho = ax2ho(eu2ax(eu)) - -end function eu2ho - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert Euler angles to cubochoric -!--------------------------------------------------------------------------------------------------- -function eu2cu(eu) result(cu) - - real(pReal), intent(in), dimension(3) :: eu - real(pReal), dimension(3) :: cu - - cu = ho2cu(eu2ho(eu)) - -end function eu2cu - - !--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @brief convert axis angle pair to quaternion @@ -916,465 +742,6 @@ pure function ax2eu(ax) result(eu) end function ax2eu -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert axis angle pair to Rodrigues vector -!--------------------------------------------------------------------------------------------------- -pure function ax2ro(ax) result(ro) - - real(pReal), intent(in), dimension(4) :: ax - real(pReal), dimension(4) :: ro - - real(pReal), parameter :: thr = 1.0e-7_pReal - - if (dEq0(ax(4))) then - ro = [ 0.0_pReal, 0.0_pReal, P, 0.0_pReal ] - else - ro(1:3) = ax(1:3) - ! we need to deal with the 180 degree case - ro(4) = merge(IEEE_value(ro(4),IEEE_positive_inf),tan(ax(4)*0.5_pReal),abs(ax(4)-PI) < thr) - end if - -end function ax2ro - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert axis angle pair to homochoric -!--------------------------------------------------------------------------------------------------- -pure function ax2ho(ax) result(ho) - - real(pReal), intent(in), dimension(4) :: ax - real(pReal), dimension(3) :: ho - - real(pReal) :: f - - f = 0.75_pReal * ( ax(4) - sin(ax(4)) ) - f = f**(1.0_pReal/3.0_pReal) - ho = ax(1:3) * f - -end function ax2ho - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert axis angle pair to cubochoric -!--------------------------------------------------------------------------------------------------- -function ax2cu(ax) result(cu) - - real(pReal), intent(in), dimension(4) :: ax - real(pReal), dimension(3) :: cu - - cu = ho2cu(ax2ho(ax)) - -end function ax2cu - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert Rodrigues vector to unit quaternion -!--------------------------------------------------------------------------------------------------- -pure function ro2qu(ro) result(qu) - - real(pReal), intent(in), dimension(4) :: ro - real(pReal), dimension(4) :: qu - - qu = ax2qu(ro2ax(ro)) - -end function ro2qu - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert Rodrigues vector to rotation matrix -!--------------------------------------------------------------------------------------------------- -pure function ro2om(ro) result(om) - - real(pReal), intent(in), dimension(4) :: ro - real(pReal), dimension(3,3) :: om - - om = ax2om(ro2ax(ro)) - -end function ro2om - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert Rodrigues vector to Euler angles -!--------------------------------------------------------------------------------------------------- -pure function ro2eu(ro) result(eu) - - real(pReal), intent(in), dimension(4) :: ro - real(pReal), dimension(3) :: eu - - eu = om2eu(ro2om(ro)) - -end function ro2eu - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert Rodrigues vector to axis angle pair -!--------------------------------------------------------------------------------------------------- -pure function ro2ax(ro) result(ax) - - real(pReal), intent(in), dimension(4) :: ro - real(pReal), dimension(4) :: ax - - real(pReal) :: ta, angle - - ta = ro(4) - - if (.not. IEEE_is_finite(ta)) then - ax = [ ro(1), ro(2), ro(3), PI ] - elseif (dEq0(ta)) then - ax = [ 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal ] - else - angle = 2.0_pReal*atan(ta) - ta = 1.0_pReal/norm2(ro(1:3)) - ax = [ ro(1)/ta, ro(2)/ta, ro(3)/ta, angle ] - end if - -end function ro2ax - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert Rodrigues vector to homochoric -!--------------------------------------------------------------------------------------------------- -pure function ro2ho(ro) result(ho) - - real(pReal), intent(in), dimension(4) :: ro - real(pReal), dimension(3) :: ho - - real(pReal) :: f - - if (dEq0(norm2(ro(1:3)))) then - ho = [ 0.0_pReal, 0.0_pReal, 0.0_pReal ] - else - f = merge(2.0_pReal*atan(ro(4)) - sin(2.0_pReal*atan(ro(4))),PI, IEEE_is_finite(ro(4))) - ho = ro(1:3) * (0.75_pReal*f)**(1.0_pReal/3.0_pReal) - end if - -end function ro2ho - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert Rodrigues vector to cubochoric -!--------------------------------------------------------------------------------------------------- -pure function ro2cu(ro) result(cu) - - real(pReal), intent(in), dimension(4) :: ro - real(pReal), dimension(3) :: cu - - cu = ho2cu(ro2ho(ro)) - -end function ro2cu - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert homochoric to unit quaternion -!--------------------------------------------------------------------------------------------------- -pure function ho2qu(ho) result(qu) - - real(pReal), intent(in), dimension(3) :: ho - real(pReal), dimension(4) :: qu - - qu = ax2qu(ho2ax(ho)) - -end function ho2qu - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert homochoric to rotation matrix -!--------------------------------------------------------------------------------------------------- -pure function ho2om(ho) result(om) - - real(pReal), intent(in), dimension(3) :: ho - real(pReal), dimension(3,3) :: om - - om = ax2om(ho2ax(ho)) - -end function ho2om - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert homochoric to Euler angles -!--------------------------------------------------------------------------------------------------- -pure function ho2eu(ho) result(eu) - - real(pReal), intent(in), dimension(3) :: ho - real(pReal), dimension(3) :: eu - - eu = ax2eu(ho2ax(ho)) - -end function ho2eu - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert homochoric to axis angle pair -!--------------------------------------------------------------------------------------------------- -pure function ho2ax(ho) result(ax) - - real(pReal), intent(in), dimension(3) :: ho - real(pReal), dimension(4) :: ax - - integer :: i - real(pReal) :: hmag_squared, s, hm - real(pReal), parameter, dimension(16) :: & - tfit = [ 1.0000000000018852_pReal, -0.5000000002194847_pReal, & - -0.024999992127593126_pReal, -0.003928701544781374_pReal, & - -0.0008152701535450438_pReal, -0.0002009500426119712_pReal, & - -0.00002397986776071756_pReal, -0.00008202868926605841_pReal, & - +0.00012448715042090092_pReal, -0.0001749114214822577_pReal, & - +0.0001703481934140054_pReal, -0.00012062065004116828_pReal, & - +0.000059719705868660826_pReal, -0.00001980756723965647_pReal, & - +0.000003953714684212874_pReal, -0.00000036555001439719544_pReal ] - - ! normalize h and store the magnitude - hmag_squared = sum(ho**2) - if (dEq0(hmag_squared)) then - ax = [ 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal ] - else - hm = hmag_squared - - ! convert the magnitude to the rotation angle - s = tfit(1) + tfit(2) * hmag_squared - do i=3,16 - hm = hm*hmag_squared - s = s + tfit(i) * hm - enddo - ax = [ho/sqrt(hmag_squared), 2.0_pReal*acos(s)] - end if - -end function ho2ax - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert homochoric to Rodrigues vector -!--------------------------------------------------------------------------------------------------- -pure function ho2ro(ho) result(ro) - - real(pReal), intent(in), dimension(3) :: ho - real(pReal), dimension(4) :: ro - - ro = ax2ro(ho2ax(ho)) - -end function ho2ro - - -!-------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief convert homochoric to cubochoric -!-------------------------------------------------------------------------- -pure function ho2cu(ho) result(cu) - - real(pReal), intent(in), dimension(3) :: ho - real(pReal), dimension(3) :: cu, xyz1, xyz3 - real(pReal), dimension(2) :: Tinv, xyz2 - real(pReal) :: rs, qxy, q2, sq2, q, tt - integer, dimension(3,2) :: p - - rs = norm2(ho) - if (rs > R1+1.e-6_pReal) then - cu = IEEE_value(cu,IEEE_positive_inf) - return - endif - - center: if (all(dEq0(ho))) then - cu = 0.0_pReal - else center - p = GetPyramidOrder(ho) - xyz3 = ho(p(:,1)) - - ! inverse M_3 - xyz2 = xyz3(1:2) * sqrt( 2.0*rs/(rs+abs(xyz3(3))) ) - - ! inverse M_2 - qxy = sum(xyz2**2) - - special: if (dEq0(qxy)) then - Tinv = 0.0_pReal - else special - q2 = qxy + maxval(abs(xyz2))**2 - sq2 = sqrt(q2) - q = (BETA/R2/R1) * sqrt(q2*qxy/(q2-maxval(abs(xyz2))*sq2)) - tt = (minval(abs(xyz2))**2+maxval(abs(xyz2))*sq2)/R2/qxy - Tinv = q * sign(1.0_pReal,xyz2) * merge([ 1.0_pReal, acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12], & - [ acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12, 1.0_pReal], & - abs(xyz2(2)) <= abs(xyz2(1))) - endif special - - ! inverse M_1 - xyz1 = [ Tinv(1), Tinv(2), sign(1.0_pReal,xyz3(3)) * rs / PREF ]/SC - - ! reverse the coordinates back to order according to the original pyramid number - cu = xyz1(p(:,2)) - - endif center - -end function ho2cu - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert cubochoric to unit quaternion -!--------------------------------------------------------------------------------------------------- -pure function cu2qu(cu) result(qu) - - real(pReal), intent(in), dimension(3) :: cu - real(pReal), dimension(4) :: qu - - qu = ho2qu(cu2ho(cu)) - -end function cu2qu - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert cubochoric to rotation matrix -!--------------------------------------------------------------------------------------------------- -pure function cu2om(cu) result(om) - - real(pReal), intent(in), dimension(3) :: cu - real(pReal), dimension(3,3) :: om - - om = ho2om(cu2ho(cu)) - -end function cu2om - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert cubochoric to Euler angles -!--------------------------------------------------------------------------------------------------- -pure function cu2eu(cu) result(eu) - - real(pReal), intent(in), dimension(3) :: cu - real(pReal), dimension(3) :: eu - - eu = ho2eu(cu2ho(cu)) - -end function cu2eu - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert cubochoric to axis angle pair -!--------------------------------------------------------------------------------------------------- -function cu2ax(cu) result(ax) - - real(pReal), intent(in), dimension(3) :: cu - real(pReal), dimension(4) :: ax - - ax = ho2ax(cu2ho(cu)) - -end function cu2ax - - -!--------------------------------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @brief convert cubochoric to Rodrigues vector -!--------------------------------------------------------------------------------------------------- -pure function cu2ro(cu) result(ro) - - real(pReal), intent(in), dimension(3) :: cu - real(pReal), dimension(4) :: ro - - ro = ho2ro(cu2ho(cu)) - -end function cu2ro - - -!-------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief map from 3D cubic grid to 3D ball -!-------------------------------------------------------------------------- -pure function cu2ho(cu) result(ho) - - real(pReal), intent(in), dimension(3) :: cu - real(pReal), dimension(3) :: ho, LamXYZ, XYZ - real(pReal), dimension(2) :: T - real(pReal) :: c, s, q - real(pReal), parameter :: eps = 1.0e-8_pReal - integer, dimension(3,2) :: p - integer, dimension(2) :: order - - if (maxval(abs(cu)) > AP/2.0+eps) then - ho = IEEE_value(cu,IEEE_positive_inf) - return - end if - - ! transform to the sphere grid via the curved square, and intercept the zero point - center: if (all(dEq0(cu))) then - ho = 0.0_pReal - else center - ! get pyramide and scale by grid parameter ratio - p = GetPyramidOrder(cu) - XYZ = cu(p(:,1)) * SC - - ! intercept all the points along the z-axis - special: if (all(dEq0(XYZ(1:2)))) then - LamXYZ = [ 0.0_pReal, 0.0_pReal, PREF * XYZ(3) ] - else special - order = merge( [2,1], [1,2], abs(XYZ(2)) <= abs(XYZ(1))) ! order of absolute values of XYZ - q = PI12 * XYZ(order(1))/XYZ(order(2)) ! smaller by larger - c = cos(q) - s = sin(q) - q = PREK * XYZ(order(2))/ sqrt(R2-c) - T = [ (R2*c - 1.0), R2 * s] * q - - ! transform to sphere grid (inverse Lambert) - ! [note that there is no need to worry about dividing by zero, since XYZ(3) can not become zero] - c = sum(T**2) - s = c * PI/(24.0*XYZ(3)**2) - c = c * sqrt(PI/24.0_pReal) / XYZ(3) - q = sqrt( 1.0 - s ) - LamXYZ = [ T(order(2)) * q, T(order(1)) * q, PREF * XYZ(3) - c ] - end if special - - ! reverse the coordinates back to order according to the original pyramid number - ho = LamXYZ(p(:,2)) - - end if center - -end function cu2ho - - -!-------------------------------------------------------------------------- -!> @author Marc De Graef, Carnegie Mellon University -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Determine to which pyramid a point in a cubic grid belongs. -!-------------------------------------------------------------------------- -pure function GetPyramidOrder(xyz) - - real(pReal),intent(in),dimension(3) :: xyz - integer, dimension(3,2) :: GetPyramidOrder - - if (((abs(xyz(1)) <= xyz(3)).and.(abs(xyz(2)) <= xyz(3))) .or. & - ((abs(xyz(1)) <= -xyz(3)).and.(abs(xyz(2)) <= -xyz(3)))) then - GetPyramidOrder = reshape([[1,2,3],[1,2,3]],[3,2]) - else if (((abs(xyz(3)) <= xyz(1)).and.(abs(xyz(2)) <= xyz(1))) .or. & - ((abs(xyz(3)) <= -xyz(1)).and.(abs(xyz(2)) <= -xyz(1)))) then - GetPyramidOrder = reshape([[2,3,1],[3,1,2]],[3,2]) - else if (((abs(xyz(1)) <= xyz(2)).and.(abs(xyz(3)) <= xyz(2))) .or. & - ((abs(xyz(1)) <= -xyz(2)).and.(abs(xyz(3)) <= -xyz(2)))) then - GetPyramidOrder = reshape([[3,1,2],[2,3,1]],[3,2]) - else - GetPyramidOrder = -1 ! should be impossible, but might simplify debugging - end if - -end function GetPyramidOrder - - !-------------------------------------------------------------------------------------------------- !> @brief Multiply two quaternions. !-------------------------------------------------------------------------------------------------- @@ -1425,17 +792,15 @@ subroutine selfTest() do i = 1, 20 if(i==1) then - qu = om2qu(math_I3) + qu = [1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal] elseif(i==2) then - qu = eu2qu([0.0_pReal,0.0_pReal,0.0_pReal]) + qu = [1.0_pReal,-0.0_pReal,-0.0_pReal,-0.0_pReal] elseif(i==3) then - qu = eu2qu([TAU,PI,TAU]) + qu = [0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal] elseif(i==4) then qu = [0.0_pReal,0.0_pReal,1.0_pReal,0.0_pReal] elseif(i==5) then - qu = ro2qu([1.0_pReal,0.0_pReal,0.0_pReal,IEEE_value(1.0_pReal, IEEE_positive_inf)]) - elseif(i==6) then - qu = ax2qu([1.0_pReal,0.0_pReal,0.0_pReal,0.0_pReal]) + qu = [0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal] else call random_number(x) A = sqrt(x(3)) @@ -1448,37 +813,16 @@ subroutine selfTest() endif - if(.not. quaternion_equal(om2qu(qu2om(qu)),qu)) error stop 'om2qu/qu2om' - if(.not. quaternion_equal(eu2qu(qu2eu(qu)),qu)) error stop 'eu2qu/qu2eu' - if(.not. quaternion_equal(ax2qu(qu2ax(qu)),qu)) error stop 'ax2qu/qu2ax' - if(.not. quaternion_equal(ro2qu(qu2ro(qu)),qu)) error stop 'ro2qu/qu2ro' - if(.not. quaternion_equal(ho2qu(qu2ho(qu)),qu)) error stop 'ho2qu/qu2ho' - if(.not. quaternion_equal(cu2qu(qu2cu(qu)),qu)) error stop 'cu2qu/qu2cu' + if(.not. quaternion_equal(om2qu(qu2om(qu)),qu)) error stop 'om2qu2om' + if(.not. quaternion_equal(eu2qu(qu2eu(qu)),qu)) error stop 'eu2qu2eu' + if(.not. quaternion_equal(ax2qu(qu2ax(qu)),qu)) error stop 'ax2qu2ax' om = qu2om(qu) - if(.not. quaternion_equal(om2qu(eu2om(om2eu(om))),qu)) error stop 'eu2om/om2eu' - if(.not. quaternion_equal(om2qu(ax2om(om2ax(om))),qu)) error stop 'ax2om/om2ax' - if(.not. quaternion_equal(om2qu(ro2om(om2ro(om))),qu)) error stop 'ro2om/om2ro' - if(.not. quaternion_equal(om2qu(ho2om(om2ho(om))),qu)) error stop 'ho2om/om2ho' - if(.not. quaternion_equal(om2qu(cu2om(om2cu(om))),qu)) error stop 'cu2om/om2cu' + if(.not. quaternion_equal(om2qu(eu2om(om2eu(om))),qu)) error stop 'eu2om2eu' + if(.not. quaternion_equal(om2qu(ax2om(om2ax(om))),qu)) error stop 'ax2om2ax' eu = qu2eu(qu) - if(.not. quaternion_equal(eu2qu(ax2eu(eu2ax(eu))),qu)) error stop 'ax2eu/eu2ax' - if(.not. quaternion_equal(eu2qu(ro2eu(eu2ro(eu))),qu)) error stop 'ro2eu/eu2ro' - if(.not. quaternion_equal(eu2qu(ho2eu(eu2ho(eu))),qu)) error stop 'ho2eu/eu2ho' - if(.not. quaternion_equal(eu2qu(cu2eu(eu2cu(eu))),qu)) error stop 'cu2eu/eu2cu' - - ax = qu2ax(qu) - if(.not. quaternion_equal(ax2qu(ro2ax(ax2ro(ax))),qu)) error stop 'ro2ax/ax2ro' - if(.not. quaternion_equal(ax2qu(ho2ax(ax2ho(ax))),qu)) error stop 'ho2ax/ax2ho' - if(.not. quaternion_equal(ax2qu(cu2ax(ax2cu(ax))),qu)) error stop 'cu2ax/ax2cu' - - ro = qu2ro(qu) - if(.not. quaternion_equal(ro2qu(ho2ro(ro2ho(ro))),qu)) error stop 'ho2ro/ro2ho' - if(.not. quaternion_equal(ro2qu(cu2ro(ro2cu(ro))),qu)) error stop 'cu2ro/ro2cu' - - ho = qu2ho(qu) - if(.not. quaternion_equal(ho2qu(cu2ho(ho2cu(ho))),qu)) error stop 'cu2ho/ho2cu' + if(.not. quaternion_equal(eu2qu(ax2eu(eu2ax(eu))),qu)) error stop 'ax2eu2ax' call R%fromMatrix(om) From 9f4e354b12eb1353c46b0a3885472f8af7644f54 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 11 Jun 2022 23:12:30 +0200 Subject: [PATCH 53/99] polishing --- src/rotations.f90 | 194 +++++++++++++++++++++++++--------------------- 1 file changed, 105 insertions(+), 89 deletions(-) diff --git a/src/rotations.f90 b/src/rotations.f90 index 7e0d33cff..d548404c9 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -27,7 +27,7 @@ ! USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ! ################################################################### -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief rotation storage and conversion @@ -44,7 +44,7 @@ ! Convention 5: the rotation angle ω is limited to the interval [0, π] ! Convention 6: the real part of a quaternion is positive, Re(q) > 0 ! Convention 7: P = -1 -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- module rotations use IO @@ -111,60 +111,64 @@ subroutine rotations_init end subroutine rotations_init -!--------------------------------------------------------------------------------------------------- -! Return rotation in different representations -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- +! Return rotation in different representations. +!-------------------------------------------------------------------------------------------------- pure function asQuaternion(self) class(tRotation), intent(in) :: self real(pReal), dimension(4) :: asQuaternion + asQuaternion = self%q end function asQuaternion -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- pure function asEulers(self) class(tRotation), intent(in) :: self real(pReal), dimension(3) :: asEulers + asEulers = qu2eu(self%q) end function asEulers -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- pure function asAxisAngle(self) class(tRotation), intent(in) :: self real(pReal), dimension(4) :: asAxisAngle + asAxisAngle = qu2ax(self%q) end function asAxisAngle -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- pure function asMatrix(self) class(tRotation), intent(in) :: self real(pReal), dimension(3,3) :: asMatrix + asMatrix = qu2om(self%q) end function asMatrix - -!--------------------------------------------------------------------------------------------------- -! Initialize rotation from different representations -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- +! Initialize rotation from different representations. +!-------------------------------------------------------------------------------------------------- subroutine fromQuaternion(self,qu) class(tRotation), intent(out) :: self real(pReal), dimension(4), intent(in) :: qu + if (dNeq(norm2(qu),1.0_pReal,1.0e-8_pReal)) call IO_error(402,ext_msg='fromQuaternion') self%q = qu end subroutine fromQuaternion -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- subroutine fromEulers(self,eu,degrees) class(tRotation), intent(out) :: self @@ -173,6 +177,7 @@ subroutine fromEulers(self,eu,degrees) real(pReal), dimension(3) :: Eulers + if (.not. present(degrees)) then Eulers = eu else @@ -185,7 +190,7 @@ subroutine fromEulers(self,eu,degrees) self%q = eu2qu(Eulers) end subroutine fromEulers -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- subroutine fromAxisAngle(self,ax,degrees,P) class(tRotation), intent(out) :: self @@ -196,6 +201,7 @@ subroutine fromAxisAngle(self,ax,degrees,P) real(pReal) :: angle real(pReal),dimension(3) :: axis + if (.not. present(degrees)) then angle = ax(4) else @@ -215,51 +221,54 @@ subroutine fromAxisAngle(self,ax,degrees,P) self%q = ax2qu([axis,angle]) end subroutine fromAxisAngle -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- subroutine fromMatrix(self,om) class(tRotation), intent(out) :: self real(pReal), dimension(3,3), intent(in) :: om + if (dNeq(math_det33(om),1.0_pReal,tol=1.0e-5_pReal)) & call IO_error(402,ext_msg='fromMatrix') self%q = om2qu(om) end subroutine fromMatrix -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- -!--------------------------------------------------------------------------------------------------- -!> @brief: Rotate a rotation -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- +!> @brief: Compose rotations. +!-------------------------------------------------------------------------------------------------- pure elemental function rotRot__(self,R) result(rRot) type(tRotation) :: rRot class(tRotation), intent(in) :: self,R - rRot = tRotation(multiply_quaternion(self%q,R%q)) + + rRot = tRotation(multiplyQuaternion(self%q,R%q)) call rRot%standardize() end function rotRot__ -!--------------------------------------------------------------------------------------------------- -!> @brief quaternion representation with positive q -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- +!> @brief Convert to quaternion representation with positive q(1). +!-------------------------------------------------------------------------------------------------- pure elemental subroutine standardize(self) class(tRotation), intent(inout) :: self + if (sign(1.0_pReal,self%q(1)) < 0.0_pReal) self%q = - self%q end subroutine standardize -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @brief Rotate a vector passively (default) or actively. -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- pure function rotVector(self,v,active) result(vRot) real(pReal), dimension(3) :: vRot @@ -270,6 +279,7 @@ pure function rotVector(self,v,active) result(vRot) real(pReal), dimension(4) :: v_normed, q logical :: passive + if (present(active)) then passive = .not. active else @@ -280,22 +290,20 @@ pure function rotVector(self,v,active) result(vRot) vRot = v else v_normed = [0.0_pReal,v]/norm2(v) - if (passive) then - q = multiply_quaternion(self%q, multiply_quaternion(v_normed, conjugate_quaternion(self%q))) - else - q = multiply_quaternion(conjugate_quaternion(self%q), multiply_quaternion(v_normed, self%q)) - endif + q = merge(multiplyQuaternion(self%q, multiplyQuaternion(v_normed, conjugateQuaternion(self%q))), & + multiplyQuaternion(conjugateQuaternion(self%q), multiplyQuaternion(v_normed, self%q)), & + passive) vRot = q(2:4)*norm2(v) endif end function rotVector -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @brief Rotate a rank-2 tensor passively (default) or actively. !> @details: Rotation is based on rotation matrix -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- pure function rotTensor2(self,T,active) result(tRot) real(pReal), dimension(3,3) :: tRot @@ -319,11 +327,11 @@ pure function rotTensor2(self,T,active) result(tRot) end function rotTensor2 -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @brief Rotate a rank-4 tensor passively (default) or actively. !> @details: rotation is based on rotation matrix !! ToDo: Need to check active/passive !!! -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- pure function rotTensor4(self,T,active) result(tRot) real(pReal), dimension(3,3,3,3) :: tRot @@ -351,11 +359,11 @@ pure function rotTensor4(self,T,active) result(tRot) end function rotTensor4 -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @brief Rotate a rank-4 stiffness tensor in Voigt 6x6 notation passively (default) or actively. !> @details: https://scicomp.stackexchange.com/questions/35600 !! ToDo: Need to check active/passive !!! -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- pure function rotStiffness(self,C,active) result(cRot) real(pReal), dimension(6,6) :: cRot @@ -391,24 +399,24 @@ pure function rotStiffness(self,C,active) result(cRot) end function rotStiffness -!--------------------------------------------------------------------------------------------------- -!> @brief Misorientation. -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate misorientation. +!-------------------------------------------------------------------------------------------------- pure elemental function misorientation(self,other) type(tRotation) :: misorientation class(tRotation), intent(in) :: self, other - misorientation%q = multiply_quaternion(other%q, conjugate_quaternion(self%q)) + misorientation%q = multiplyQuaternion(other%q, conjugateQuaternion(self%q)) end function misorientation -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @brief Convert unit quaternion to rotation matrix. -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- pure function qu2om(qu) result(om) real(pReal), intent(in), dimension(4) :: qu @@ -436,10 +444,10 @@ pure function qu2om(qu) result(om) end function qu2om -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief Convert unit quaternion to Euler angles. -!--------------------------------------------------------------------------------------------------- +!> @brief Convert unit quaternion to Bunge Euler angles. +!-------------------------------------------------------------------------------------------------- pure function qu2eu(qu) result(eu) real(pReal), intent(in), dimension(4) :: qu @@ -466,10 +474,10 @@ pure function qu2eu(qu) result(eu) end function qu2eu -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert unit quaternion to axis angle pair -!--------------------------------------------------------------------------------------------------- +!> @brief Convert unit quaternion to axis-angle pair. +!-------------------------------------------------------------------------------------------------- pure function qu2ax(qu) result(ax) real(pReal), intent(in), dimension(4) :: qu @@ -477,6 +485,7 @@ pure function qu2ax(qu) result(ax) real(pReal) :: omega, s + if (dEq0(sum(qu(2:4)**2))) then ax = [ 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal ] ! axis = [001] elseif (dNeq0(qu(1))) then @@ -490,11 +499,11 @@ pure function qu2ax(qu) result(ax) end function qu2ax -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief convert rotation matrix to unit quaternion +!> @brief Convert rotation matrix to unit quaternion. !> @details the original formulation (direct conversion) had (numerical?) issues -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- pure function om2qu(om) result(qu) real(pReal), intent(in), dimension(3,3) :: om @@ -503,6 +512,7 @@ pure function om2qu(om) result(qu) real(pReal) :: trace,s trace = math_trace33(om) + if(trace > 0.0_pReal) then s = 0.5_pReal / sqrt(trace+1.0_pReal) qu = [0.25_pReal/s, (om(3,2)-om(2,3))*s,(om(1,3)-om(3,1))*s,(om(2,1)-om(1,2))*s] @@ -525,17 +535,18 @@ pure function om2qu(om) result(qu) end function om2qu -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert orientation matrix to Euler angles +!> @brief Convert orientation matrix to Bunge Euler angles. !> @details Two step check for special cases to avoid invalid operations (not needed for python) -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- pure function om2eu(om) result(eu) real(pReal), intent(in), dimension(3,3) :: om real(pReal), dimension(3) :: eu real(pReal) :: zeta + if (dNeq(abs(om(3,3)),1.0_pReal,1.e-8_pReal)) then zeta = 1.0_pReal/sqrt(math_clip(1.0_pReal-om(3,3)**2,1e-64_pReal,1.0_pReal)) eu = [atan2(om(3,1)*zeta,-om(3,2)*zeta), & @@ -550,10 +561,10 @@ pure function om2eu(om) result(eu) end function om2eu -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert orientation matrix to axis angle pair -!--------------------------------------------------------------------------------------------------- +!> @brief Convert orientation matrix to axis-angle pair. +!-------------------------------------------------------------------------------------------------- function om2ax(om) result(ax) real(pReal), intent(in), dimension(3,3) :: om @@ -565,6 +576,7 @@ function om2ax(om) result(ax) real(pReal), dimension(3,3) :: VR, devNull, om_ integer :: ierr, i + om_ = om ! first get the rotation angle @@ -586,10 +598,10 @@ function om2ax(om) result(ax) end function om2ax -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief Euler angles to unit quaternion -!--------------------------------------------------------------------------------------------------- +!> @brief Convert Bunge Euler angles to unit quaternion. +!-------------------------------------------------------------------------------------------------- pure function eu2qu(eu) result(qu) real(pReal), intent(in), dimension(3) :: eu @@ -597,6 +609,7 @@ pure function eu2qu(eu) result(qu) real(pReal), dimension(3) :: ee real(pReal) :: cPhi, sPhi + ee = 0.5_pReal*eu cPhi = cos(ee(2)) @@ -611,10 +624,10 @@ pure function eu2qu(eu) result(qu) end function eu2qu -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief Euler angles to orientation matrix -!--------------------------------------------------------------------------------------------------- +!> @brief Convert Euler angles to orientation matrix. +!-------------------------------------------------------------------------------------------------- pure function eu2om(eu) result(om) real(pReal), intent(in), dimension(3) :: eu @@ -622,6 +635,7 @@ pure function eu2om(eu) result(om) real(pReal), dimension(3) :: c, s + c = cos(eu) s = sin(eu) @@ -640,10 +654,10 @@ pure function eu2om(eu) result(om) end function eu2om -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert euler to axis angle -!--------------------------------------------------------------------------------------------------- +!> @brief Convert Bunge Euler angles to axis-angle pair. +!-------------------------------------------------------------------------------------------------- pure function eu2ax(eu) result(ax) real(pReal), intent(in), dimension(3) :: eu @@ -651,6 +665,7 @@ pure function eu2ax(eu) result(ax) real(pReal) :: t, delta, tau, alpha, sigma + t = tan(eu(2)*0.5_pReal) sigma = 0.5_pReal*(eu(1)+eu(3)) delta = 0.5_pReal*(eu(1)-eu(3)) @@ -669,10 +684,10 @@ pure function eu2ax(eu) result(ax) end function eu2ax -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert axis angle pair to quaternion -!--------------------------------------------------------------------------------------------------- +!> @brief Convert axis-angle pair to unit quaternion. +!-------------------------------------------------------------------------------------------------- pure function ax2qu(ax) result(qu) real(pReal), intent(in), dimension(4) :: ax @@ -692,10 +707,10 @@ pure function ax2qu(ax) result(qu) end function ax2qu -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert axis angle pair to orientation matrix -!--------------------------------------------------------------------------------------------------- +!> @brief Convert axis-angle pair to orientation matrix. +!-------------------------------------------------------------------------------------------------- pure function ax2om(ax) result(om) real(pReal), intent(in), dimension(4) :: ax @@ -703,6 +718,7 @@ pure function ax2om(ax) result(om) real(pReal) :: q, c, s, omc + c = cos(ax(4)) s = sin(ax(4)) omc = 1.0_pReal-c @@ -728,15 +744,16 @@ pure function ax2om(ax) result(om) end function ax2om -!--------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert axis angle pair to Euler angles -!--------------------------------------------------------------------------------------------------- +!> @brief Convert axis-angle pair to Bunge Euler angles. +!-------------------------------------------------------------------------------------------------- pure function ax2eu(ax) result(eu) real(pReal), intent(in), dimension(4) :: ax real(pReal), dimension(3) :: eu + eu = om2eu(ax2om(ax)) end function ax2eu @@ -745,33 +762,32 @@ end function ax2eu !-------------------------------------------------------------------------------------------------- !> @brief Multiply two quaternions. !-------------------------------------------------------------------------------------------------- -pure function multiply_quaternion(qu1,qu2) +pure function multiplyQuaternion(qu1,qu2) real(pReal), dimension(4), intent(in) :: qu1, qu2 - real(pReal), dimension(4) :: multiply_quaternion + real(pReal), dimension(4) :: multiplyQuaternion - multiply_quaternion(1) = qu1(1)*qu2(1) - qu1(2)*qu2(2) - qu1(3)*qu2(3) - qu1(4)*qu2(4) - multiply_quaternion(2) = qu1(1)*qu2(2) + qu1(2)*qu2(1) + P * (qu1(3)*qu2(4) - qu1(4)*qu2(3)) - multiply_quaternion(3) = qu1(1)*qu2(3) + qu1(3)*qu2(1) + P * (qu1(4)*qu2(2) - qu1(2)*qu2(4)) - multiply_quaternion(4) = qu1(1)*qu2(4) + qu1(4)*qu2(1) + P * (qu1(2)*qu2(3) - qu1(3)*qu2(2)) + multiplyQuaternion(1) = qu1(1)*qu2(1) - qu1(2)*qu2(2) - qu1(3)*qu2(3) - qu1(4)*qu2(4) + multiplyQuaternion(2) = qu1(1)*qu2(2) + qu1(2)*qu2(1) + P * (qu1(3)*qu2(4) - qu1(4)*qu2(3)) + multiplyQuaternion(3) = qu1(1)*qu2(3) + qu1(3)*qu2(1) + P * (qu1(4)*qu2(2) - qu1(2)*qu2(4)) + multiplyQuaternion(4) = qu1(1)*qu2(4) + qu1(4)*qu2(1) + P * (qu1(2)*qu2(3) - qu1(3)*qu2(2)) -end function multiply_quaternion +end function multiplyQuaternion !-------------------------------------------------------------------------------------------------- !> @brief Calculate conjugate complex of a quaternion. !-------------------------------------------------------------------------------------------------- -pure function conjugate_quaternion(qu) +pure function conjugateQuaternion(qu) real(pReal), dimension(4), intent(in) :: qu - real(pReal), dimension(4) :: conjugate_quaternion + real(pReal), dimension(4) :: conjugateQuaternion - conjugate_quaternion = [qu(1), -qu(2), -qu(3), -qu(4)] + conjugateQuaternion = [qu(1), -qu(2), -qu(3), -qu(4)] - -end function conjugate_quaternion +end function conjugateQuaternion !-------------------------------------------------------------------------------------------------- @@ -780,8 +796,8 @@ end function conjugate_quaternion subroutine selfTest() type(tRotation) :: R - real(pReal), dimension(4) :: qu, ax, ro - real(pReal), dimension(3) :: x, eu, ho, v3 + real(pReal), dimension(4) :: qu, ax + real(pReal), dimension(3) :: x, eu, v3 real(pReal), dimension(3,3) :: om, t33 real(pReal), dimension(3,3,3,3) :: t3333 real(pReal), dimension(6,6) :: C From f60c950a7c52d6f9ffe48e3f70ae6865e94ef6a0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 11 Jun 2022 23:21:34 +0200 Subject: [PATCH 54/99] numerically better normalization slightly more expensive, but guarantees a det(R) = 1.0 --- src/math.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/math.f90 b/src/math.f90 index 25c90ccf4..b92e1870b 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -1129,7 +1129,7 @@ pure function math_rotationalPart(F) result(R) - I_U(1)*I_F(1) * transpose(F) & + I_U(1) * transpose(matmul(F,F)) & - matmul(F,C) - R = R /(I_U(1)*I_U(2)-I_U(3)) + R = R*math_det33(R)**(-1.0/3.0) end function math_rotationalPart From 0d63284c01e101612f65fb5719172b65c7cc2fc9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 12 Jun 2022 16:16:25 +0200 Subject: [PATCH 55/99] increase test coverage --- src/math.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index b92e1870b..882706ea7 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -1129,7 +1129,7 @@ pure function math_rotationalPart(F) result(R) - I_U(1)*I_F(1) * transpose(F) & + I_U(1) * transpose(matmul(F,F)) & - matmul(F,C) - R = R*math_det33(R)**(-1.0/3.0) + R = R*math_det33(R)**(-1.0_pReal/3.0_pReal) end function math_rotationalPart @@ -1422,7 +1422,9 @@ subroutine selfTest() t33_2 = math_rotationalPart(transpose(t33)) t33 = math_rotationalPart(t33) if (any(dNeq0(matmul(t33_2,t33) - math_I3,tol=1.0e-10_pReal))) & - error stop 'math_rotationalPart' + error stop 'math_rotationalPart (forward-backward)' + if (dNeq(1.0_pReal,math_det33(math_rotationalPart(t33)),tol=1.0e-10_pReal)) & + error stop 'math_rotationalPart (determinant)' call random_number(r) d = int(r*5.0_pReal) + 1 From 576c79a619a9ee6b15c692523cfa9fff4cc51fb7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 13 Jun 2022 14:08:45 +0200 Subject: [PATCH 56/99] following DAMASK paper --- .../dislotwin_alpha-Brass-shearbanding.yaml | 7 +- src/phase_mechanical_plastic_dislotwin.f90 | 64 +++++++++---------- 2 files changed, 37 insertions(+), 34 deletions(-) diff --git a/examples/config/phase/mechanical/plastic/dislotwin_alpha-Brass-shearbanding.yaml b/examples/config/phase/mechanical/plastic/dislotwin_alpha-Brass-shearbanding.yaml index 54f05984f..414be0b85 100644 --- a/examples/config/phase/mechanical/plastic/dislotwin_alpha-Brass-shearbanding.yaml +++ b/examples/config/phase/mechanical/plastic/dislotwin_alpha-Brass-shearbanding.yaml @@ -4,9 +4,12 @@ references: - N. Jia et al., Acta Materialia 60(3):1099-1115, 2012, https://doi.org/10.1016/j.actamat.2011.10.047 + - N. Jia et al., + Acta Materialia 60:3415-3434, 2012, + https://doi.org/10.1016/j.actamat.2012.03.005 -v_sb: 0.0001 -xi_sb: 300.0e6 # tau_hat_sb +gamma_0_sb: 0.0001 +tau_sb: 180.0e6 # tau_hat_sb Q_sb: 4.0e-19 # Q_0 p_sb: 1.15 q_sb: 1.0 diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index 858ef5955..46dea8639 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -11,26 +11,26 @@ submodule(phase:plastic) dislotwin type :: tParameters real(pReal) :: & - Q_cl = 1.0_pReal, & !< activation energy for dislocation climb - omega = 1.0_pReal, & !< frequency factor for dislocation climb - D = 1.0_pReal, & !< grain size - p_sb = 1.0_pReal, & !< p-exponent in shear band velocity - q_sb = 1.0_pReal, & !< q-exponent in shear band velocity - i_tw = 1.0_pReal, & !< adjustment parameter to calculate MFP for twinning - i_tr = 1.0_pReal, & !< adjustment parameter to calculate MFP for transformation - L_tw = 1.0_pReal, & !< length of twin nuclei - L_tr = 1.0_pReal, & !< length of trans nuclei - x_c = 1.0_pReal, & !< critical distance for formation of twin/trans nucleus - V_cs = 1.0_pReal, & !< cross slip volume - xi_sb = 1.0_pReal, & !< value for shearband resistance - v_sb = 1.0_pReal, & !< value for shearband velocity_0 - E_sb = 1.0_pReal, & !< activation energy for shear bands - h = 1.0_pReal, & !< stack height of hex nucleus - gamma_char_tr = sqrt(0.125_pReal), & !< Characteristic shear for transformation - a_cF = 1.0_pReal, & - cOverA_hP = 1.0_pReal, & - V_mol = 1.0_pReal, & - rho = 1.0_pReal + Q_cl = 1.0_pReal, & !< activation energy for dislocation climb + omega = 1.0_pReal, & !< frequency factor for dislocation climb + D = 1.0_pReal, & !< grain size + p_sb = 1.0_pReal, & !< p-exponent in shear band velocity + q_sb = 1.0_pReal, & !< q-exponent in shear band velocity + i_tw = 1.0_pReal, & !< adjustment parameter to calculate MFP for twinning + i_tr = 1.0_pReal, & !< adjustment parameter to calculate MFP for transformation + L_tw = 1.0_pReal, & !< length of twin nuclei + L_tr = 1.0_pReal, & !< length of trans nuclei + x_c = 1.0_pReal, & !< critical distance for formation of twin/trans nucleus + V_cs = 1.0_pReal, & !< cross slip volume + tau_sb = 1.0_pReal, & !< value for shearband resistance + gamma_0_sb = 1.0_pReal, & !< value for shearband velocity_0 + E_sb = 1.0_pReal, & !< activation energy for shear bands + h = 1.0_pReal, & !< stack height of hex nucleus + gamma_char_tr = sqrt(0.125_pReal), & !< Characteristic shear for transformation + a_cF = 1.0_pReal, & + cOverA_hP = 1.0_pReal, & + V_mol = 1.0_pReal, & + rho = 1.0_pReal type(tPolynomial) :: & Gamma_sf, & !< stacking fault energy Delta_G !< free energy difference between austensite and martensite @@ -331,18 +331,18 @@ module function plastic_dislotwin_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! shearband related parameters - prm%v_sb = pl%get_asFloat('v_sb',defaultVal=0.0_pReal) - if (prm%v_sb > 0.0_pReal) then - prm%xi_sb = pl%get_asFloat('xi_sb') + prm%gamma_0_sb = pl%get_asFloat('gamma_0_sb',defaultVal=0.0_pReal) + if (prm%gamma_0_sb > 0.0_pReal) then + prm%tau_sb = pl%get_asFloat('tau_sb') prm%E_sb = pl%get_asFloat('Q_sb') prm%p_sb = pl%get_asFloat('p_sb') prm%q_sb = pl%get_asFloat('q_sb') ! sanity checks - if (prm%xi_sb < 0.0_pReal) extmsg = trim(extmsg)//' xi_sb' - if (prm%E_sb < 0.0_pReal) extmsg = trim(extmsg)//' Q_sb' - if (prm%p_sb <= 0.0_pReal) extmsg = trim(extmsg)//' p_sb' - if (prm%q_sb <= 0.0_pReal) extmsg = trim(extmsg)//' q_sb' + if (prm%tau_sb < 0.0_pReal) extmsg = trim(extmsg)//' tau_sb' + if (prm%E_sb < 0.0_pReal) extmsg = trim(extmsg)//' Q_sb' + if (prm%p_sb <= 0.0_pReal) extmsg = trim(extmsg)//' p_sb' + if (prm%q_sb <= 0.0_pReal) extmsg = trim(extmsg)//' q_sb' end if !-------------------------------------------------------------------------------------------------- @@ -569,7 +569,7 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en) Lp = Lp * f_matrix dLp_dMp = dLp_dMp * f_matrix - shearBandingContribution: if (dNeq0(prm%v_sb)) then + shearBandingContribution: if (dNeq0(prm%gamma_0_sb)) then E_kB_T = prm%E_sb/(K_B*T) call math_eigh33(eigValues,eigVectors,Mp) ! is Mp symmetric by design? @@ -580,10 +580,10 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en) tau = math_tensordot(Mp,P_sb) significantShearBandStress: if (abs(tau) > tol_math_check) then - StressRatio_p = (abs(tau)/prm%xi_sb)**prm%p_sb - dot_gamma_sb = sign(prm%v_sb*exp(-E_kB_T*(1-StressRatio_p)**prm%q_sb), tau) - ddot_gamma_dtau = abs(dot_gamma_sb)*E_kB_T*prm%p_sb*prm%q_sb/prm%xi_sb & - * (abs(tau)/prm%xi_sb)**(prm%p_sb-1.0_pReal) & + StressRatio_p = (abs(tau)/prm%tau_sb)**prm%p_sb + dot_gamma_sb = sign(prm%gamma_0_sb*exp(-E_kB_T*(1-StressRatio_p)**prm%q_sb), tau) + ddot_gamma_dtau = abs(dot_gamma_sb)*E_kB_T*prm%p_sb*prm%q_sb/prm%tau_sb & + * (abs(tau)/prm%tau_sb)**(prm%p_sb-1.0_pReal) & * (1.0_pReal-StressRatio_p)**(prm%q_sb-1.0_pReal) Lp = Lp + dot_gamma_sb * P_sb From 655103d39edc5c0213d15d1e6a70e8d72ee9b226 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 13 Jun 2022 19:35:37 +0200 Subject: [PATCH 57/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-458-g132823519 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 104caef74..09973b4ed 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-453-g98b307f0c +3.0.0-alpha6-458-g132823519 From 703798b080a81d4e96828222d1a4b62703759849 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 15 Jun 2022 08:28:20 +0200 Subject: [PATCH 58/99] test needs update after change of parameter names for sb --- PRIVATE | 2 +- src/phase_mechanical_plastic_dislotwin.f90 | 46 +++++++++++----------- 2 files changed, 24 insertions(+), 24 deletions(-) diff --git a/PRIVATE b/PRIVATE index 1da271831..b14f78e96 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 1da271831a4afd0f4a8d46fdbaaf863529fdde06 +Subproject commit b14f78e96a8e2986aaf6845b98ea77fec92bc997 diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index 46dea8639..dfd84ffc9 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -9,28 +9,28 @@ !-------------------------------------------------------------------------------------------------- submodule(phase:plastic) dislotwin + real(pReal), parameter :: gamma_char_tr = sqrt(0.125_pReal) !< Characteristic shear for transformation type :: tParameters real(pReal) :: & - Q_cl = 1.0_pReal, & !< activation energy for dislocation climb - omega = 1.0_pReal, & !< frequency factor for dislocation climb - D = 1.0_pReal, & !< grain size - p_sb = 1.0_pReal, & !< p-exponent in shear band velocity - q_sb = 1.0_pReal, & !< q-exponent in shear band velocity - i_tw = 1.0_pReal, & !< adjustment parameter to calculate MFP for twinning - i_tr = 1.0_pReal, & !< adjustment parameter to calculate MFP for transformation - L_tw = 1.0_pReal, & !< length of twin nuclei - L_tr = 1.0_pReal, & !< length of trans nuclei - x_c = 1.0_pReal, & !< critical distance for formation of twin/trans nucleus - V_cs = 1.0_pReal, & !< cross slip volume - tau_sb = 1.0_pReal, & !< value for shearband resistance - gamma_0_sb = 1.0_pReal, & !< value for shearband velocity_0 - E_sb = 1.0_pReal, & !< activation energy for shear bands - h = 1.0_pReal, & !< stack height of hex nucleus - gamma_char_tr = sqrt(0.125_pReal), & !< Characteristic shear for transformation - a_cF = 1.0_pReal, & - cOverA_hP = 1.0_pReal, & - V_mol = 1.0_pReal, & - rho = 1.0_pReal + Q_cl = 1.0_pReal, & !< activation energy for dislocation climb + omega = 1.0_pReal, & !< frequency factor for dislocation climb + D = 1.0_pReal, & !< grain size + p_sb = 1.0_pReal, & !< p-exponent in shear band velocity + q_sb = 1.0_pReal, & !< q-exponent in shear band velocity + i_tw = 1.0_pReal, & !< adjustment parameter to calculate MFP for twinning + i_tr = 1.0_pReal, & !< adjustment parameter to calculate MFP for transformation + L_tw = 1.0_pReal, & !< length of twin nuclei + L_tr = 1.0_pReal, & !< length of trans nuclei + x_c = 1.0_pReal, & !< critical distance for formation of twin/trans nucleus + V_cs = 1.0_pReal, & !< cross slip volume + tau_sb = 1.0_pReal, & !< value for shearband resistance + gamma_0_sb = 1.0_pReal, & !< value for shearband velocity_0 + E_sb = 1.0_pReal, & !< activation energy for shear bands + h = 1.0_pReal, & !< stack height of hex nucleus + a_cF = 1.0_pReal, & + cOverA_hP = 1.0_pReal, & + V_mol = 1.0_pReal, & + rho = 1.0_pReal type(tPolynomial) :: & Gamma_sf, & !< stacking fault energy Delta_G !< free energy difference between austensite and martensite @@ -697,7 +697,7 @@ module function dislotwin_dotState(Mp,ph,en) result(dotState) dot_f_tw = f_matrix*dot_gamma_tw/prm%gamma_char_tw if (prm%sum_N_tr > 0) call kinetics_tr(Mp,T,abs_dot_gamma_sl,ph,en,dot_gamma_tr) - dot_f_tr = f_matrix*dot_gamma_tr/prm%gamma_char_tr + dot_f_tr = f_matrix*dot_gamma_tr/gamma_char_tr end associate @@ -1026,9 +1026,9 @@ pure subroutine kinetics_tr(Mp,T,abs_dot_gamma_sl,ph,en,& dP_ncs_dtau = prm%V_cs / (K_B * T) * (P_ncs - 1.0_pReal) V = PI/4.0_pReal*dst%Lambda_tr(i,en)**2*prm%t_tr(i) - dot_gamma_tr(i) = V*dot_N_0*P_ncs*P*prm%gamma_char_tr + dot_gamma_tr(i) = V*dot_N_0*P_ncs*P*gamma_char_tr if (present(ddot_gamma_dtau_tr)) & - ddot_gamma_dtau_tr(i) = V*dot_N_0*(P*dP_ncs_dtau + P_ncs*dP_dtau)*prm%gamma_char_tr + ddot_gamma_dtau_tr(i) = V*dot_N_0*(P*dP_ncs_dtau + P_ncs*dP_dtau)*gamma_char_tr else dot_gamma_tr(i) = 0.0_pReal if (present(ddot_gamma_dtau_tr)) ddot_gamma_dtau_tr(i) = 0.0_pReal From 0e4a8f284d4579e8f1827ae53ca6caf79addac09 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 15 Jun 2022 15:35:14 +0200 Subject: [PATCH 59/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-464-g540eeb4a6 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 09973b4ed..c8e8ced4c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-458-g132823519 +3.0.0-alpha6-464-g540eeb4a6 From 77fa2a1d93d0e328263483d1d6f9af7320399e34 Mon Sep 17 00:00:00 2001 From: "d.mentock" Date: Wed, 15 Jun 2022 15:48:34 +0200 Subject: [PATCH 60/99] adjustments to patchfile required for marc2021/2022 spack packages --- .../2021.3.1/Marc_tools/include_linux64.patch | 44 ++++++++++--------- .../2022.1/Marc_tools/include_linux64.patch | 24 +++++----- python/damask/solver/_marc.py | 37 ++++++++++------ 3 files changed, 61 insertions(+), 44 deletions(-) diff --git a/install/MarcMentat/2021.3.1/Marc_tools/include_linux64.patch b/install/MarcMentat/2021.3.1/Marc_tools/include_linux64.patch index 5d78b22f8..a90c60aa6 100644 --- a/install/MarcMentat/2021.3.1/Marc_tools/include_linux64.patch +++ b/install/MarcMentat/2021.3.1/Marc_tools/include_linux64.patch @@ -1,18 +1,22 @@ --- +++ -@@ -119,6 +119,11 @@ if test "$MSCCOSIM_VERSION" = ""; then +@@ -119,6 +119,15 @@ if test "$MSCCOSIM_VERSION" = ""; then MSCCOSIM_VERSION="2020" fi - + +# DAMASK uses the HDF5 compiler wrapper around the Intel compiler -+H5FC="$(h5fc -shlib -show)" -+HDF5_LIB=${H5FC//ifort/} ++H5FC=$(h5fc -shlib -show) ++if [[ "$H5FC" == *"$dir is"* ]]; then ++ H5FC=$(echo $(echo "$H5FC" | tail -n1) | sed -e "s/\-shlib/-fPIC -integer-size 64 -real-size 64 -qopenmp/g") ++ H5FC=${H5FC%-lmpifort*} ++fi ++HDF5_LIB=${H5FC//*"ifort"/} +FCOMP="$H5FC" + # AEM if test "$MARCDLLOUTDIR" = ""; then DLLOUTDIR="$MARC_LIB" -@@ -439,7 +444,7 @@ if test "$MARC_INTEGER_SIZE" = "i4" ; then +@@ -439,7 +448,7 @@ if test "$MARC_INTEGER_SIZE" = "i4" ; then I8DEFINES= I8CDEFINES= else @@ -21,29 +25,29 @@ I8DEFINES="-DI64" I8CDEFINES="-U_DOUBLE -D_SINGLE" fi - -@@ -556,7 +561,7 @@ then + +@@ -556,7 +565,7 @@ then PROFILE=" $PROFILE -pg" fi - + -FORT_OPT="-c -assume byterecl -safe_cray_ptr -mp1 -WB -fp-model source" +FORT_OPT="-c -implicitnone -stand f18 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr -mp1 -WB -fp-model source" if test "$MTHREAD" = "OPENMP" then FORT_OPT=" $FORT_OPT -qopenmp" -@@ -569,7 +574,7 @@ else +@@ -569,7 +578,7 @@ else FORT_OPT=" $FORT_OPT -save -zero" fi if test "$MARCHDF_HDF" = "HDF"; then - FORT_OPT="$FORT_OPT -DMARCHDF_HDF=$MARCHDF_HDF $HDF_INCLUDE" + FORT_OPT="$FORT_OPT -DMARCHDF=$MARCHDF_HDF" fi - + FORTLOW="$FCOMP $FORT_OPT $PROFILE -O0 $I8FFLAGS -I$MARC_SOURCE/common \ -@@ -583,6 +588,30 @@ FORTNA="$FCOMP $FORT_OPT -fno-alias -O3 $I8FFLAGS -I$MARC_SOURCE/common \ +@@ -583,6 +592,30 @@ FORTNA="$FCOMP $FORT_OPT -fno-alias -O3 $I8FFLAGS -I$MARC_SOURCE/common \ # for compiling free form f90 files. high opt, integer(4) FORTF90="$FCOMP -c -O3" - + +# determine DAMASK version +if test -n "$DAMASK_USER"; then + DAMASKROOT=`dirname $DAMASK_USER`/.. @@ -71,30 +75,30 @@ if test "$MARCDEBUG" = "ON" then FORTLOW="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \ -@@ -739,7 +768,7 @@ SECLIBS="-L$MARC_LIB -llapi" - +@@ -739,7 +772,7 @@ SECLIBS="-L$MARC_LIB -llapi" + SOLVERLIBS="${BCSSOLVERLIBS} ${VKISOLVERLIBS} ${CASISOLVERLIBS} ${MF2SOLVERLIBS} \ -L$MARC_MKL \ - $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/libkdtree2.a $MARC_LIB/libtetmeshinterface.a $MARC_LIB/libcaefatigueinterface.a -L$MARC_LIB -lmkl_blacs_intelmpi_ilp64 -lmkl_scalapack_ilp64 -lmkl_intel_ilp64 -lmkl_intel_thread -lmkl_core -liomp5 -ltetmesh -lmeshgems -lmg-tetra -lmeshgems_stubs $HDF_LIBS $SOLVER2LIBS" + $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/libkdtree2.a $MARC_LIB/libtetmeshinterface.a $MARC_LIB/libcaefatigueinterface.a -L$MARC_LIB -lmkl_blacs_intelmpi_ilp64 -lmkl_scalapack_ilp64 -lmkl_intel_ilp64 -lmkl_intel_thread -lmkl_core -liomp5 -ltetmesh -lmeshgems -lmg-tetra -lmeshgems_stubs $HDF5_LIB $SOLVER2LIBS" - + SOLVERLIBS_DLL=${SOLVERLIBS} if test "$AEM_DLL" -eq 1 -@@ -762,7 +791,7 @@ then +@@ -762,7 +795,7 @@ then OPENSSL=NONE fi - + -SYSLIBS=" $OPENMP -lpthread -shared-intel -cxxlib" +SYSLIBS=" $OPENMP -lpthread -cxxlib" - + # Uncomment the following lines to turn on the trace and comment out the next 4 lines # if test $MPITYPE = intelmpi -@@ -772,7 +801,7 @@ SYSLIBS=" $OPENMP -lpthread -shared-intel -cxxlib" +@@ -772,7 +805,7 @@ SYSLIBS=" $OPENMP -lpthread -shared-intel -cxxlib" # fi if test $MPITYPE = intelmpi then - SYSLIBS="-L${MPI_ROOT}/lib/release -lmpi -L${MPI_ROOT}/lib -lmpifort -lrt $OPENMP -threads -lpthread -shared-intel -cxxlib" + SYSLIBS="-L${MPI_ROOT}/lib/release -lmpi -L${MPI_ROOT}/lib -lmpifort -lrt $OPENMP -threads -lpthread -cxxlib" fi - + if test "$ZLIB" = "ZLIB"; then diff --git a/install/MarcMentat/2022.1/Marc_tools/include_linux64.patch b/install/MarcMentat/2022.1/Marc_tools/include_linux64.patch index 8cf6d2113..d11e84f1a 100644 --- a/install/MarcMentat/2022.1/Marc_tools/include_linux64.patch +++ b/install/MarcMentat/2022.1/Marc_tools/include_linux64.patch @@ -5,14 +5,18 @@ fi +# DAMASK uses the HDF5 compiler wrapper around the Intel compiler -+H5FC="$(h5fc -shlib -show)" -+HDF5_LIB=${H5FC//ifort/} ++H5FC=$(h5fc -shlib -show) ++if [[ "$H5FC" == *"$dir is"* ]]; then ++ H5FC=$(echo $(echo "$H5FC" | tail -n1) | sed -e "s/\-shlib/-fPIC -integer-size 64 -real-size 64 -qopenmp/g") ++ H5FC=${H5FC%-lmpifort*} ++fi ++HDF5_LIB=${H5FC//*"ifort"/} +FCOMP="$H5FC" + # AEM if test "$MARCDLLOUTDIR" = ""; then DLLOUTDIR="$MARC_LIB" -@@ -477,8 +482,8 @@ if test "$MARC_INTEGER_SIZE" = "i4" ; then +@@ -477,8 +486,8 @@ if test "$MARC_INTEGER_SIZE" = "i4" ; then I8DEFINES= I8CDEFINES= else @@ -22,7 +26,7 @@ I8CDEFINES="-U_DOUBLE -D_SINGLE" fi -@@ -594,7 +599,7 @@ then +@@ -594,7 +605,7 @@ then PROFILE=" $PROFILE -pg" fi @@ -31,7 +35,7 @@ if test "$MTHREAD" = "OPENMP" then FORT_OPT=" $FORT_OPT -qopenmp" -@@ -607,7 +612,7 @@ else +@@ -607,7 +616,7 @@ else FORT_OPT=" $FORT_OPT -save -zero" fi if test "$MARCHDF_HDF" = "HDF"; then @@ -40,10 +44,10 @@ fi FORTLOW="$FCOMP $FORT_OPT $PROFILE -O0 $I8FFLAGS -I$MARC_SOURCE/common \ -@@ -621,6 +626,29 @@ FORTNA="$FCOMP $FORT_OPT -fno-alias -O3 $I8FFLAGS -I$MARC_SOURCE/common \ +@@ -621,6 +630,29 @@ FORTNA="$FCOMP $FORT_OPT -fno-alias -O3 $I8FFLAGS -I$MARC_SOURCE/common \ # for compiling free form f90 files. high opt, integer(4) FORTF90="$FCOMP -c -O3" - + +# determine DAMASK version +if test -n "$DAMASK_USER"; then + DAMASKROOT=`dirname $DAMASK_USER`/.. @@ -71,12 +75,12 @@ then FORTLOW="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \ @@ -778,7 +806,7 @@ SECLIBS="-L$MARC_LIB -llapi" - + SOLVERLIBS="${BCSSOLVERLIBS} ${VKISOLVERLIBS} ${CASISOLVERLIBS} ${MF2SOLVERLIBS} \ -L$MARC_MKL \ - $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/libkdtree2.a $MARC_LIB/libtetmeshinterface.a $MARC_LIB/libcaefatigueinterface.a -L$MARC_LIB -lmkl_blacs_intelmpi_ilp64 -lmkl_scalapack_ilp64 -lmkl_intel_ilp64 -lmkl_intel_thread -lmkl_core -liomp5 -ltetmesh -lmeshgems -lmg-tetra -lmeshgems_stubs $HDF_LIBS $SOLVER2LIBS" + $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/libkdtree2.a $MARC_LIB/libtetmeshinterface.a $MARC_LIB/libcaefatigueinterface.a -L$MARC_LIB -lmkl_blacs_intelmpi_ilp64 -lmkl_scalapack_ilp64 -lmkl_intel_ilp64 -lmkl_intel_thread -lmkl_core -liomp5 -ltetmesh -lmeshgems -lmg-tetra -lmeshgems_stubs $HDF5_LIB $SOLVER2LIBS" - + SOLVERLIBS_DLL=${SOLVERLIBS} if test "$AEM_DLL" -eq 1 @@ -802,7 +830,7 @@ then @@ -85,7 +89,7 @@ -SYSLIBS=" $OPENMP -lpthread -shared-intel -cxxlib $MARC_RPC_LIB" +SYSLIBS=" $OPENMP -lpthread -cxxlib $MARC_RPC_LIB" - + # Uncomment the following lines to turn on the trace and comment out the next 4 lines # if test $MPITYPE = intelmpi @@ -812,7 +840,7 @@ SYSLIBS=" $OPENMP -lpthread -shared-intel -cxxlib $MARC_RPC_LIB" diff --git a/python/damask/solver/_marc.py b/python/damask/solver/_marc.py index 8b7f7acba..51c65a695 100644 --- a/python/damask/solver/_marc.py +++ b/python/damask/solver/_marc.py @@ -10,18 +10,26 @@ _damask_root = str(Path(__file__).parents[3]) class Marc: """Wrapper to run DAMASK with MSC Marc.""" - def __init__(self,marc_version=_marc_version,marc_root=_marc_root,damask_root=_damask_root): + def __init__(self, + version: str = _marc_version, + marc_root: str = _marc_root, + damask_root: str = _damask_root): """ Create a Marc solver object. Parameters ---------- - version : string - Marc version + version : str, optional + Marc version. Defaults to latest supported Marc version. + marc_root : str, optional + Marc root location. Defaults to /opt/msc. + damask_root : str, optional + DAMASK root location. + Default is autodected based on location of the Python library. """ - self.marc_version = marc_version - self.marc_root = Path(marc_root) + self.marc_version = version + self.marc_root = Path(marc_root) self.damask_root = Path(damask_root) @property @@ -44,9 +52,10 @@ class Marc: return path_tools - def submit_job(self, model, job, - compile = False, - optimization = ''): + def submit_job(self, model: str, job: str, + compile: bool = False, + optimization: str = '', + env = None): """ Assemble command line arguments and call Marc executable. @@ -62,6 +71,8 @@ class Marc: optimization : str, optional Optimization level '' (-O0), 'l' (-O1), or 'h' (-O3). Defaults to ''. + env : dict, optional + Environment for execution. """ usersub = (self.damask_root/'src/Marc/DAMASK_Marc').with_suffix('.f90' if compile else '.marc') @@ -73,18 +84,16 @@ class Marc: cmd = f'{self.tools_path/script} -jid {model}_{job} -nprocd 1 -autorst 0 -ci n -cr n -dcoup 0 -b no -v no ' \ + (f'-u {usersub} -save y' if compile else f'-prog {usersub.with_suffix("")}') - print(cmd) - ret = subprocess.run(shlex.split(cmd),capture_output=True) + ret = subprocess.run(shlex.split(cmd),capture_output=True,env=env) - try: - v = int(re.search('Exit number ([0-9]+)',ret.stderr.decode()).group(1)) - if 3004 != v: + if (m := re.search('Exit number ([0-9]+)',ret.stderr.decode())) is not None: + if 3004 != (v := int(m.group(1))): print(ret.stderr.decode()) print(ret.stdout.decode()) raise RuntimeError(f'Marc simulation failed ({v})') - except (AttributeError,ValueError): + else: print(ret.stderr.decode()) print(ret.stdout.decode()) raise RuntimeError('Marc simulation failed (unknown return value)') From 074cdf5dff2ec76b712988d8d6ba52883bb6922b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 15 Jun 2022 20:15:35 +0200 Subject: [PATCH 61/99] following default style --- src/rotations.f90 | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/rotations.f90 b/src/rotations.f90 index d548404c9..f6ef57783 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -182,7 +182,7 @@ subroutine fromEulers(self,eu,degrees) Eulers = eu else Eulers = merge(eu*INRAD,eu,degrees) - endif + end if if (any(Eulers<0.0_pReal) .or. any(Eulers>TAU) .or. Eulers(2) > PI) & call IO_error(402,ext_msg='fromEulers') @@ -206,14 +206,14 @@ subroutine fromAxisAngle(self,ax,degrees,P) angle = ax(4) else angle = merge(ax(4)*INRAD,ax(4),degrees) - endif + end if if (.not. present(P)) then axis = ax(1:3) else axis = ax(1:3) * merge(-1.0_pReal,1.0_pReal,P == 1) if(abs(P) /= 1) call IO_error(402,ext_msg='fromAxisAngle (P)') - endif + end if if(dNeq(norm2(axis),1.0_pReal) .or. angle < 0.0_pReal .or. angle > PI) & call IO_error(402,ext_msg='fromAxisAngle') @@ -284,7 +284,7 @@ pure function rotVector(self,v,active) result(vRot) passive = .not. active else passive = .true. - endif + end if if (dEq0(norm2(v))) then vRot = v @@ -294,7 +294,7 @@ pure function rotVector(self,v,active) result(vRot) multiplyQuaternion(conjugateQuaternion(self%q), multiplyQuaternion(v_normed, self%q)), & passive) vRot = q(2:4)*norm2(v) - endif + end if end function rotVector @@ -318,7 +318,7 @@ pure function rotTensor2(self,T,active) result(tRot) passive = .not. active else passive = .true. - endif + end if tRot = merge(matmul(matmul(self%asMatrix(),T),transpose(self%asMatrix())), & matmul(matmul(transpose(self%asMatrix()),T),self%asMatrix()), & @@ -347,14 +347,14 @@ pure function rotTensor4(self,T,active) result(tRot) R = merge(transpose(self%asMatrix()),self%asMatrix(),active) else R = self%asMatrix() - endif + end if tRot = 0.0_pReal do i = 1,3;do j = 1,3;do k = 1,3;do l = 1,3 do m = 1,3;do n = 1,3;do o = 1,3;do p = 1,3 tRot(i,j,k,l) = tRot(i,j,k,l) & + R(i,m) * R(j,n) * R(k,o) * R(l,p) * T(m,n,o,p) - enddo; enddo; enddo; enddo; enddo; enddo; enddo; enddo + end do; end do; end do; end do; end do; end do; end do; end do end function rotTensor4 @@ -379,7 +379,7 @@ pure function rotStiffness(self,C,active) result(cRot) R = merge(transpose(self%asMatrix()),self%asMatrix(),active) else R = self%asMatrix() - endif + end if M = reshape([R(1,1)**2, R(2,1)**2, R(3,1)**2, & R(2,1)*R(3,1), R(1,1)*R(3,1), R(1,1)*R(2,1), & @@ -468,7 +468,7 @@ pure function qu2eu(qu) result(eu) eu = [atan2((-P*qu(1)*qu(3)+qu(2)*qu(4))*chi, (-P*qu(1)*qu(2)-qu(3)*qu(4))*chi ), & atan2( 2.0_pReal*chi, q03-q12 ), & atan2(( P*qu(1)*qu(3)+qu(2)*qu(4))*chi, (-P*qu(1)*qu(2)+qu(3)*qu(4))*chi )] - endif degenerated + end if degenerated where(sign(1.0_pReal,eu)<0.0_pReal) eu = mod(eu+TAU,[TAU,PI,TAU]) end function qu2eu @@ -526,8 +526,8 @@ pure function om2qu(om) result(qu) else s = 2.0_pReal * sqrt( 1.0_pReal + om(3,3) - om(1,1) - om(2,2) ) qu = [ (om(2,1) - om(1,2)) /s,(om(1,3) + om(3,1)) / s,(om(2,3) + om(3,2)) / s,0.25_pReal * s] - endif - endif + end if + end if if(sign(1.0_pReal,qu(1))<0.0_pReal) qu =-1.0_pReal * qu qu(2:4) = merge(qu(2:4),qu(2:4)*P,dEq0(qu(2:4))) qu = qu/norm2(qu) @@ -593,7 +593,7 @@ function om2ax(om) result(ax) ax(1:3) = VR(1:3,i) where ( dNeq0([om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)])) & ax(1:3) = sign(ax(1:3),-P *[om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)]) - endif + end if end function om2ax @@ -826,7 +826,7 @@ subroutine selfTest() cos(TAU*x(2))*B,& sin(TAU*x(1))*A] if(qu(1)<0.0_pReal) qu = qu * (-1.0_pReal) - endif + end if if(.not. quaternion_equal(om2qu(qu2om(qu)),qu)) error stop 'om2qu2om' From 5881d010b9734bdc5f994f6a4c7a846218d81c4a Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 17 Jun 2022 10:12:48 +0200 Subject: [PATCH 62/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-476-gac626db9d --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index c8e8ced4c..12c5e4193 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-464-g540eeb4a6 +3.0.0-alpha6-476-gac626db9d From b8c3d75700896da2822d5e3ac1796395b09ef506 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 21 Jun 2022 22:46:54 +0200 Subject: [PATCH 63/99] [skip sc] enforce interfaces (quick fix: declare as external) --- src/CLI.f90 | 2 +- src/HDF5_utilities.f90 | 2 +- src/IO.f90 | 2 +- src/LAPACK_interface.f90 | 10 +++++----- src/Marc/DAMASK_Marc.f90 | 8 ++++---- src/Marc/discretization_Marc.f90 | 2 +- src/Marc/element.f90 | 2 +- src/Marc/materialpoint_Marc.f90 | 2 +- src/YAML_parse.f90 | 4 ++-- src/YAML_types.f90 | 2 +- src/config.f90 | 2 +- src/constants.f90 | 2 +- src/discretization.f90 | 2 +- src/geometry_plastic_nonlocal.f90 | 2 +- src/grid/DAMASK_grid.f90 | 2 +- src/grid/FFTW.f90 | 2 +- src/grid/VTI.f90 | 2 +- src/grid/base64.f90 | 2 +- src/grid/discretization_grid.f90 | 2 +- src/grid/grid_damage_spectral.f90 | 2 +- src/grid/grid_mech_FEM.f90 | 2 +- src/grid/grid_mech_spectral_basic.f90 | 2 +- src/grid/grid_mech_spectral_polarisation.f90 | 2 +- src/grid/grid_thermal_spectral.f90 | 2 +- src/grid/spectral_utilities.f90 | 2 +- src/grid/zlib.f90 | 4 ++-- src/homogenization.f90 | 2 +- src/lattice.f90 | 2 +- src/material.f90 | 2 +- src/materialpoint.f90 | 2 +- src/math.f90 | 2 +- src/mesh/DAMASK_mesh.f90 | 2 +- src/mesh/FEM_quadrature.f90 | 2 +- src/mesh/FEM_utilities.f90 | 7 ++++++- src/mesh/discretization_mesh.f90 | 4 +++- src/mesh/mesh_mech_FEM.f90 | 11 ++++++++++- src/parallelization.f90 | 2 +- src/phase.f90 | 2 +- src/polynomials.f90 | 2 +- src/prec.f90 | 2 +- src/quit.f90 | 2 +- src/results.f90 | 2 +- src/rotations.f90 | 4 ++-- src/signals.f90 | 2 +- src/system_routines.f90 | 18 +++++++++--------- 45 files changed, 79 insertions(+), 63 deletions(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index cc73365d6..ee1555cb2 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -18,7 +18,7 @@ module CLI use parallelization use system_routines - implicit none + implicit none(type,external) private integer, public, protected :: & CLI_restartInc = 0 !< Increment at which calculation starts diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index c905164c2..eab1ca73f 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -18,7 +18,7 @@ module HDF5_utilities use prec use parallelization - implicit none + implicit none(type,external) private !-------------------------------------------------------------------------------------------------- diff --git a/src/IO.f90 b/src/IO.f90 index 9b9b9d563..31bb0ed2d 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -12,7 +12,7 @@ module IO use prec - implicit none + implicit none(type,external) private character(len=*), parameter, public :: & diff --git a/src/LAPACK_interface.f90 b/src/LAPACK_interface.f90 index 43ddb5771..cc451b59c 100644 --- a/src/LAPACK_interface.f90 +++ b/src/LAPACK_interface.f90 @@ -8,7 +8,7 @@ module LAPACK_interface pure subroutine dgeev(jobvl,jobvr,n,a,lda,wr,wi,vl,ldvl,vr,ldvr,work,lwork,info) use prec - implicit none + implicit none(type,external) character, intent(in) :: jobvl,jobvr integer, intent(in) :: n,lda,ldvl,ldvr,lwork @@ -22,7 +22,7 @@ module LAPACK_interface pure subroutine dgesv(n,nrhs,a,lda,ipiv,b,ldb,info) use prec - implicit none + implicit none(type,external) integer, intent(in) :: n,nrhs,lda,ldb real(pReal), intent(inout), dimension(lda,n) :: a @@ -33,7 +33,7 @@ module LAPACK_interface pure subroutine dgetrf(m,n,a,lda,ipiv,info) use prec - implicit none + implicit none(type,external) integer, intent(in) :: m,n,lda real(pReal), intent(inout), dimension(lda,n) :: a @@ -43,7 +43,7 @@ module LAPACK_interface pure subroutine dgetri(n,a,lda,ipiv,work,lwork,info) use prec - implicit none + implicit none(type,external) integer, intent(in) :: n,lda,lwork real(pReal), intent(inout), dimension(lda,n) :: a @@ -54,7 +54,7 @@ module LAPACK_interface pure subroutine dsyev(jobz,uplo,n,a,lda,w,work,lwork,info) use prec - implicit none + implicit none(type,external) character, intent(in) :: jobz,uplo integer, intent(in) :: n,lda,lwork diff --git a/src/Marc/DAMASK_Marc.f90 b/src/Marc/DAMASK_Marc.f90 index 28cdf9223..01eb8c5ef 100644 --- a/src/Marc/DAMASK_Marc.f90 +++ b/src/Marc/DAMASK_Marc.f90 @@ -25,7 +25,7 @@ module DAMASK_interface use ifport, only: & CHDIR - implicit none + implicit none(type,external) private logical, protected, public :: symmetricSolver @@ -210,7 +210,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & use materialpoint_Marc use OMP_LIB - implicit none + implicit none(type,external) integer, intent(in) :: & ! according to MSC.Marc 2012 Manual D ngens, & !< size of stress-strain law nn, & !< integration point number @@ -382,7 +382,7 @@ subroutine flux(f,ts,n,time) use homogenization use discretization_Marc - implicit none + implicit none(type,external) real(pReal), dimension(6), intent(in) :: & ts integer, dimension(10), intent(in) :: & @@ -409,7 +409,7 @@ subroutine uedinc(inc,incsub) use materialpoint_Marc use discretization_Marc - implicit none + implicit none(type,external) integer, intent(in) :: inc, incsub integer :: n, nqncomp, nqdatatype integer, save :: inc_written diff --git a/src/Marc/discretization_Marc.f90 b/src/Marc/discretization_Marc.f90 index 8886e3ebb..a0667d049 100644 --- a/src/Marc/discretization_Marc.f90 +++ b/src/Marc/discretization_Marc.f90 @@ -17,7 +17,7 @@ module discretization_Marc use geometry_plastic_nonlocal use results - implicit none + implicit none(type,external) private real(pReal), public, protected :: & diff --git a/src/Marc/element.f90 b/src/Marc/element.f90 index b53322f34..2940704bd 100644 --- a/src/Marc/element.f90 +++ b/src/Marc/element.f90 @@ -5,7 +5,7 @@ module element use IO - implicit none + implicit none(type,external) private !--------------------------------------------------------------------------------------------------- diff --git a/src/Marc/materialpoint_Marc.f90 b/src/Marc/materialpoint_Marc.f90 index 2ad98109d..72c718a87 100644 --- a/src/Marc/materialpoint_Marc.f90 +++ b/src/Marc/materialpoint_Marc.f90 @@ -23,7 +23,7 @@ module materialpoint_Marc use discretization use discretization_Marc - implicit none + implicit none(type,external) private real(pReal), dimension (:,:,:), allocatable, private :: & diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90 index 67abfdd90..e7d64770d 100644 --- a/src/YAML_parse.f90 +++ b/src/YAML_parse.f90 @@ -12,7 +12,7 @@ module YAML_parse use system_routines #endif - implicit none + implicit none(type,external) private public :: & @@ -24,7 +24,7 @@ module YAML_parse subroutine to_flow_C(flow,length_flow,mixed) bind(C) use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR, C_PTR - implicit none + implicit none(type,external) type(C_PTR), intent(out) :: flow integer(C_INT), intent(out) :: length_flow diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index e685209e6..e9bdff88d 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -11,7 +11,7 @@ module YAML_types use IO use prec - implicit none + implicit none(type,external) private type, abstract, public :: tNode diff --git a/src/config.f90 b/src/config.f90 index 78723c19f..5c31e3b25 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -9,7 +9,7 @@ module config use results use parallelization - implicit none + implicit none(type,external) private class(tNode), pointer, public :: & diff --git a/src/constants.f90 b/src/constants.f90 index 1effb8d95..7d1892e9d 100644 --- a/src/constants.f90 +++ b/src/constants.f90 @@ -5,7 +5,7 @@ module constants use prec - implicit none + implicit none(type,external) public real(pReal), parameter :: & diff --git a/src/discretization.f90 b/src/discretization.f90 index 95fd39fd5..f24b0eadf 100644 --- a/src/discretization.f90 +++ b/src/discretization.f90 @@ -7,7 +7,7 @@ module discretization use prec use results - implicit none + implicit none(type,external) private integer, public, protected :: & diff --git a/src/geometry_plastic_nonlocal.f90 b/src/geometry_plastic_nonlocal.f90 index 571ca2e6a..09c40f8b3 100644 --- a/src/geometry_plastic_nonlocal.f90 +++ b/src/geometry_plastic_nonlocal.f90 @@ -9,7 +9,7 @@ module geometry_plastic_nonlocal use prec use results - implicit none + implicit none(type,external) public integer, protected :: & diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 0d41338a1..c36a4eeb2 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -30,7 +30,7 @@ program DAMASK_grid use grid_thermal_spectral use results - implicit none + implicit none(type,external) type :: tLoadCase type(tRotation) :: rot !< rotation of BC diff --git a/src/grid/FFTW.f90 b/src/grid/FFTW.f90 index e552e78e0..5df432061 100644 --- a/src/grid/FFTW.f90 +++ b/src/grid/FFTW.f90 @@ -5,7 +5,7 @@ module FFTW3 use, intrinsic :: ISO_C_binding - implicit none + implicit none(type,external) public include 'fftw3-mpi.f03' diff --git a/src/grid/VTI.f90 b/src/grid/VTI.f90 index a5918137e..98cb55e54 100644 --- a/src/grid/VTI.f90 +++ b/src/grid/VTI.f90 @@ -8,7 +8,7 @@ module VTI use base64 use IO - implicit none + implicit none(type,external) private public :: & diff --git a/src/grid/base64.f90 b/src/grid/base64.f90 index 448f57d2a..6e580f043 100644 --- a/src/grid/base64.f90 +++ b/src/grid/base64.f90 @@ -7,7 +7,7 @@ module base64 use prec use IO - implicit none + implicit none(type,external) private character(len=*), parameter :: & diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 916cf6e69..565695bb8 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -23,7 +23,7 @@ module discretization_grid use discretization use geometry_plastic_nonlocal - implicit none + implicit none(type,external) private integer, dimension(3), public, protected :: & diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index dc21a1a2c..55e442106 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -22,7 +22,7 @@ module grid_damage_spectral use YAML_types use config - implicit none + implicit none(type,external) private type :: tNumerics diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 52be43362..4734d87a2 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -27,7 +27,7 @@ module grid_mechanical_FEM use discretization use discretization_grid - implicit none + implicit none(type,external) private type(tSolutionParams) :: params diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index 7931be0c7..a9582ebb9 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -26,7 +26,7 @@ module grid_mechanical_spectral_basic use homogenization use discretization_grid - implicit none + implicit none(type,external) private type(tSolutionParams) :: params diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 198e333d5..c6d3c82e2 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -26,7 +26,7 @@ module grid_mechanical_spectral_polarisation use homogenization use discretization_grid - implicit none + implicit none(type,external) private type(tSolutionParams) :: params diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 8483fe336..391d80b9d 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -25,7 +25,7 @@ module grid_thermal_spectral use YAML_types use config - implicit none + implicit none(type,external) private type :: tNumerics diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 2e00c10f4..9bd0a2348 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -22,7 +22,7 @@ module spectral_utilities use discretization use homogenization - implicit none + implicit none(type,external) private !-------------------------------------------------------------------------------------------------- diff --git a/src/grid/zlib.f90 b/src/grid/zlib.f90 index 10a62a55b..f0fc274ed 100644 --- a/src/grid/zlib.f90 +++ b/src/grid/zlib.f90 @@ -5,7 +5,7 @@ module zlib use prec - implicit none + implicit none(type,external) private public :: & @@ -15,7 +15,7 @@ module zlib subroutine inflate_C(s_deflated,s_inflated,deflated,inflated) bind(C) use, intrinsic :: ISO_C_Binding, only: C_SIGNED_CHAR, C_INT64_T - implicit none + implicit none(type,external) integer(C_INT64_T), intent(in) :: s_deflated,s_inflated integer(C_SIGNED_CHAR), dimension(s_deflated), intent(in) :: deflated diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 290f3de9b..b1e462794 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -18,7 +18,7 @@ module homogenization use results use lattice - implicit none + implicit none(type,external) private type :: tState diff --git a/src/lattice.f90 b/src/lattice.f90 index 2c2da345d..5339dc9ac 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -13,7 +13,7 @@ module lattice use math use rotations - implicit none + implicit none(type,external) private !-------------------------------------------------------------------------------------------------- diff --git a/src/material.f90 b/src/material.f90 index eafc411cd..1ec844382 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -14,7 +14,7 @@ module material use discretization use YAML_types - implicit none + implicit none(type,external) private type, public :: tRotationContainer diff --git a/src/materialpoint.f90 b/src/materialpoint.f90 index d83307738..5b8b690e0 100644 --- a/src/materialpoint.f90 +++ b/src/materialpoint.f90 @@ -31,7 +31,7 @@ module materialpoint use discretization_grid #endif - implicit none + implicit none(type,external) public contains diff --git a/src/math.f90 b/src/math.f90 index a814d7b99..d11ad1565 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -12,7 +12,7 @@ module math use YAML_types use LAPACK_interface - implicit none + implicit none(type,external) public #if __INTEL_COMPILER >= 1900 ! do not make use of associated entities available to other modules diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90 index f0f2a872e..5489ac36e 100644 --- a/src/mesh/DAMASK_mesh.f90 +++ b/src/mesh/DAMASK_mesh.f90 @@ -20,7 +20,7 @@ program DAMASK_mesh use FEM_Utilities use mesh_mechanical_FEM - implicit none + implicit none(type,external) type :: tLoadCase real(pReal) :: time = 0.0_pReal !< length of increment diff --git a/src/mesh/FEM_quadrature.f90 b/src/mesh/FEM_quadrature.f90 index f519dc377..a2217847a 100644 --- a/src/mesh/FEM_quadrature.f90 +++ b/src/mesh/FEM_quadrature.f90 @@ -5,7 +5,7 @@ module FEM_quadrature use prec - implicit none + implicit none(type,external) private integer, parameter :: & diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 4e31a0475..60a95d83c 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -21,7 +21,7 @@ module FEM_utilities use homogenization use FEM_quadrature - implicit none + implicit none(type,external) private logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill @@ -65,6 +65,11 @@ module FEM_utilities type(tComponentBC), allocatable, dimension(:) :: componentBC end type tFieldBC + external :: & + PetscSectionGetFieldComponents, & + PetscSectionGetFieldDof, & + PetscSectionGetFieldOffset + public :: & FEM_utilities_init, & utilities_constitutiveResponse, & diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index b898c4e6b..fe101ba6b 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -25,7 +25,7 @@ module discretization_mesh use YAML_types use prec - implicit none + implicit none(type,external) private integer, public, protected :: & @@ -52,6 +52,8 @@ module discretization_mesh real(pReal), dimension(:,:,:), allocatable :: & mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) + external :: & + DMView ! ToDo: write interface public :: & discretization_mesh_init, & mesh_FEM_build_ipVolumes, & diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index 5f02011eb..22af0a709 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -26,7 +26,7 @@ module mesh_mechanical_FEM use homogenization use math - implicit none + implicit none(type,external) private !-------------------------------------------------------------------------------------------------- @@ -67,6 +67,15 @@ module mesh_mechanical_FEM logical :: ForwardData real(pReal), parameter :: eps = 1.0e-18_pReal + external :: & + PetscSectionGetNumFields, & + PetscFESetQuadrature, & + PetscFEGetDimension, & + PetscFEDestroy, & + PetscSectionGetDof, & + PetscFEGetDualSpace, & + PetscDualSpaceGetFunctional + public :: & FEM_mechanical_init, & FEM_mechanical_solution, & diff --git a/src/parallelization.f90 b/src/parallelization.f90 index d631711d8..d2c982d1d 100644 --- a/src/parallelization.f90 +++ b/src/parallelization.f90 @@ -18,7 +18,7 @@ module parallelization use prec - implicit none + implicit none(type,external) private #ifndef PETSC diff --git a/src/phase.f90 b/src/phase.f90 index af7197f7b..f9f3a8125 100644 --- a/src/phase.f90 +++ b/src/phase.f90 @@ -19,7 +19,7 @@ module phase use HDF5 use HDF5_utilities - implicit none + implicit none(type,external) private type :: tState diff --git a/src/polynomials.f90 b/src/polynomials.f90 index e04db16f5..eeb4152f2 100644 --- a/src/polynomials.f90 +++ b/src/polynomials.f90 @@ -8,7 +8,7 @@ module polynomials use YAML_parse use YAML_types - implicit none + implicit none(type,external) private type, public :: tPolynomial diff --git a/src/prec.f90 b/src/prec.f90 index 73563d4f2..963391c39 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -15,7 +15,7 @@ module prec use PETScSys #endif - implicit none + implicit none(type,external) public ! https://stevelionel.com/drfortran/2017/03/27/doctor-fortran-in-it-takes-all-kinds diff --git a/src/quit.f90 b/src/quit.f90 index aa8bcb0fb..3a46658e2 100644 --- a/src/quit.f90 +++ b/src/quit.f90 @@ -12,7 +12,7 @@ subroutine quit(stop_id) #endif use HDF5 - implicit none + implicit none(type,external) integer, intent(in) :: stop_id integer, dimension(8) :: dateAndTime integer :: err_HDF5 diff --git a/src/results.f90 b/src/results.f90 index cf1b4de5c..6849d7577 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -21,7 +21,7 @@ module results use DAMASK_interface #endif - implicit none + implicit none(type,external) private integer(HID_T) :: resultsFile diff --git a/src/rotations.f90 b/src/rotations.f90 index f6ef57783..83d945ea9 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -50,7 +50,7 @@ module rotations use IO use math - implicit none + implicit none(type,external) private real(pReal), parameter :: P = -1.0_pReal !< parameter for orientation conversion. @@ -796,7 +796,7 @@ end function conjugateQuaternion subroutine selfTest() type(tRotation) :: R - real(pReal), dimension(4) :: qu, ax + real(pReal), dimension(4) :: qu real(pReal), dimension(3) :: x, eu, v3 real(pReal), dimension(3,3) :: om, t33 real(pReal), dimension(3,3,3,3) :: t3333 diff --git a/src/signals.f90 b/src/signals.f90 index 7db101f94..3f0397d3d 100644 --- a/src/signals.f90 +++ b/src/signals.f90 @@ -6,7 +6,7 @@ module signals use prec use system_routines - implicit none + implicit none(type,external) private logical, volatile, public, protected :: & diff --git a/src/system_routines.f90 b/src/system_routines.f90 index a74c2e417..3ce6ba6ce 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -7,7 +7,7 @@ module system_routines use prec - implicit none + implicit none(type,external) private public :: & @@ -27,7 +27,7 @@ module system_routines function setCWD_C(cwd) bind(C) use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR - implicit none + implicit none(type,external) integer(C_INT) :: setCWD_C character(kind=C_CHAR), dimension(*), intent(in) :: cwd @@ -36,7 +36,7 @@ module system_routines subroutine getCWD_C(cwd, stat) bind(C) use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR use prec - implicit none + implicit none(type,external) character(kind=C_CHAR), dimension(pPathLen+1), intent(out) :: cwd ! NULL-terminated array integer(C_INT), intent(out) :: stat @@ -45,7 +45,7 @@ module system_routines subroutine getHostName_C(hostname, stat) bind(C) use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR use prec - implicit none + implicit none(type,external) character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: hostname ! NULL-terminated array integer(C_INT), intent(out) :: stat @@ -54,7 +54,7 @@ module system_routines subroutine getUserName_C(username, stat) bind(C) use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR use prec - implicit none + implicit none(type,external) character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: username ! NULL-terminated array integer(C_INT), intent(out) :: stat @@ -62,28 +62,28 @@ module system_routines subroutine signalint_C(handler) bind(C) use, intrinsic :: ISO_C_Binding, only: C_FUNPTR - implicit none + implicit none(type,external) type(C_FUNPTR), intent(in), value :: handler end subroutine signalint_C subroutine signalusr1_C(handler) bind(C) use, intrinsic :: ISO_C_Binding, only: C_FUNPTR - implicit none + implicit none(type,external) type(C_FUNPTR), intent(in), value :: handler end subroutine signalusr1_C subroutine signalusr2_C(handler) bind(C) use, intrinsic :: ISO_C_Binding, only: C_FUNPTR - implicit none + implicit none(type,external) type(C_FUNPTR), intent(in), value :: handler end subroutine signalusr2_C subroutine free_C(ptr) bind(C,name='free') use, intrinsic :: ISO_C_Binding, only: C_PTR - implicit none + implicit none(type,external) type(C_PTR), value :: ptr end subroutine free_C From 2f1904efec8e53ec35fc40bce844febd83ab9e96 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 21 Jun 2022 23:11:22 +0200 Subject: [PATCH 64/99] only MPI_f08 is standard conforming --- src/HDF5_utilities.f90 | 4 ++++ src/grid/DAMASK_grid.f90 | 4 ++++ src/grid/discretization_grid.f90 | 4 ++++ src/grid/grid_damage_spectral.f90 | 4 ++++ src/grid/grid_mech_FEM.f90 | 5 +++++ src/grid/grid_mech_spectral_basic.f90 | 4 ++++ src/grid/grid_mech_spectral_polarisation.f90 | 4 ++++ src/grid/grid_thermal_spectral.f90 | 4 ++++ src/grid/spectral_utilities.f90 | 5 +++++ src/mesh/FEM_utilities.f90 | 4 ++++ src/mesh/discretization_mesh.f90 | 4 ++++ src/mesh/mesh_mech_FEM.f90 | 4 ++++ src/parallelization.f90 | 4 ++++ src/quit.f90 | 6 ++++++ src/results.f90 | 4 ++++ 15 files changed, 64 insertions(+) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index eab1ca73f..ee1e3cf8c 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -18,7 +18,11 @@ module HDF5_utilities use prec use parallelization +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private !-------------------------------------------------------------------------------------------------- diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index c36a4eeb2..dbaa668c2 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -30,7 +30,11 @@ program DAMASK_grid use grid_thermal_spectral use results +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif type :: tLoadCase type(tRotation) :: rot !< rotation of BC diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 565695bb8..682a3e5b2 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -23,7 +23,11 @@ module discretization_grid use discretization use geometry_plastic_nonlocal +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private integer, dimension(3), public, protected :: & diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index 55e442106..8b544ec87 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -22,7 +22,11 @@ module grid_damage_spectral use YAML_types use config +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private type :: tNumerics diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 4734d87a2..1040d6fb7 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -27,7 +27,12 @@ module grid_mechanical_FEM use discretization use discretization_grid + +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private type(tSolutionParams) :: params diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index a9582ebb9..dec677df8 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -26,7 +26,11 @@ module grid_mechanical_spectral_basic use homogenization use discretization_grid +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private type(tSolutionParams) :: params diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index c6d3c82e2..d0d229c46 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -26,7 +26,11 @@ module grid_mechanical_spectral_polarisation use homogenization use discretization_grid +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private type(tSolutionParams) :: params diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 391d80b9d..ff0c5b403 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -25,7 +25,11 @@ module grid_thermal_spectral use YAML_types use config +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private type :: tNumerics diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 9bd0a2348..aa2ed1de9 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -22,7 +22,12 @@ module spectral_utilities use discretization use homogenization + +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private !-------------------------------------------------------------------------------------------------- diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 60a95d83c..4d24a10b3 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -21,7 +21,11 @@ module FEM_utilities use homogenization use FEM_quadrature +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index fe101ba6b..ad358e40b 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -25,7 +25,11 @@ module discretization_mesh use YAML_types use prec +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private integer, public, protected :: & diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index 22af0a709..90c3aa31e 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -26,7 +26,11 @@ module mesh_mechanical_FEM use homogenization use math +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private !-------------------------------------------------------------------------------------------------- diff --git a/src/parallelization.f90 b/src/parallelization.f90 index d2c982d1d..5c7e9bff3 100644 --- a/src/parallelization.f90 +++ b/src/parallelization.f90 @@ -18,7 +18,11 @@ module parallelization use prec +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private #ifndef PETSC diff --git a/src/quit.f90 b/src/quit.f90 index 3a46658e2..4fc6bf11b 100644 --- a/src/quit.f90 +++ b/src/quit.f90 @@ -12,8 +12,14 @@ subroutine quit(stop_id) #endif use HDF5 +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif + integer, intent(in) :: stop_id + integer, dimension(8) :: dateAndTime integer :: err_HDF5 integer(MPI_INTEGER_KIND) :: err_MPI diff --git a/src/results.f90 b/src/results.f90 index 6849d7577..17efc87e3 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -21,7 +21,11 @@ module results use DAMASK_interface #endif +#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) +#else + implicit none +#endif private integer(HID_T) :: resultsFile From 445a091fec689a2ddb433ccd075b43e63c65aba6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 24 Jun 2022 07:04:52 +0200 Subject: [PATCH 65/99] easier to understand --- src/homogenization_damage.f90 | 17 +++++++---------- src/homogenization_thermal.f90 | 13 ++++++------- src/phase.f90 | 3 ++- src/phase_damage.f90 | 17 +++++++++-------- src/phase_thermal.f90 | 13 +++++++------ 5 files changed, 31 insertions(+), 32 deletions(-) diff --git a/src/homogenization_damage.f90 b/src/homogenization_damage.f90 index 2e66da591..3363408d0 100644 --- a/src/homogenization_damage.f90 +++ b/src/homogenization_damage.f90 @@ -3,8 +3,6 @@ !-------------------------------------------------------------------------------------------------- submodule(homogenization) damage - use lattice - interface module subroutine pass_init @@ -79,8 +77,9 @@ end subroutine damage_init !-------------------------------------------------------------------------------------------------- module subroutine damage_partition(ce) + integer, intent(in) :: ce + real(pReal) :: phi - integer, intent(in) :: ce if(damageState_h(material_homogenizationID(ce))%sizeState < 1) return @@ -91,7 +90,7 @@ end subroutine damage_partition !-------------------------------------------------------------------------------------------------- -!> @brief Homogenized damage viscosity. +!> @brief Homogenize damage viscosity. !-------------------------------------------------------------------------------------------------- module function homogenization_mu_phi(ce) result(mu) @@ -105,7 +104,7 @@ end function homogenization_mu_phi !-------------------------------------------------------------------------------------------------- -!> @brief Homogenized damage conductivity/diffusivity in reference configuration. +!> @brief Homogenize damage conductivity. !-------------------------------------------------------------------------------------------------- module function homogenization_K_phi(ce) result(K) @@ -119,13 +118,12 @@ end function homogenization_K_phi !-------------------------------------------------------------------------------------------------- -!> @brief Homogenized damage driving force. +!> @brief Homogenize damage driving force. !-------------------------------------------------------------------------------------------------- module function homogenization_f_phi(phi,ce) result(f) integer, intent(in) :: ce - real(pReal), intent(in) :: & - phi + real(pReal), intent(in) :: phi real(pReal) :: f @@ -140,8 +138,7 @@ end function homogenization_f_phi module subroutine homogenization_set_phi(phi,ce) integer, intent(in) :: ce - real(pReal), intent(in) :: & - phi + real(pReal), intent(in) :: phi integer :: & ho, & diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 index e9c9d2195..ceed47365 100644 --- a/src/homogenization_thermal.f90 +++ b/src/homogenization_thermal.f90 @@ -3,8 +3,6 @@ !-------------------------------------------------------------------------------------------------- submodule(homogenization) thermal - use lattice - interface module subroutine pass_init @@ -89,7 +87,7 @@ end subroutine thermal_init !-------------------------------------------------------------------------------------------------- module subroutine thermal_partition(ce) - integer, intent(in) :: ce + integer, intent(in) :: ce real(pReal) :: T, dot_T integer :: co @@ -105,7 +103,7 @@ end subroutine thermal_partition !-------------------------------------------------------------------------------------------------- -!> @brief Homogenized thermal viscosity. +!> @brief Homogenize thermal viscosity. !-------------------------------------------------------------------------------------------------- module function homogenization_mu_T(ce) result(mu) @@ -124,7 +122,7 @@ end function homogenization_mu_T !-------------------------------------------------------------------------------------------------- -!> @brief Homogenized thermal conductivity in reference configuration. +!> @brief Homogenize thermal conductivity. !-------------------------------------------------------------------------------------------------- module function homogenization_K_T(ce) result(K) @@ -143,7 +141,7 @@ end function homogenization_K_T !-------------------------------------------------------------------------------------------------- -!> @brief Homogenized heat generation rate. +!> @brief Homogenize heat generation rate. !-------------------------------------------------------------------------------------------------- module function homogenization_f_T(ce) result(f) @@ -167,7 +165,7 @@ end function homogenization_f_T module subroutine homogenization_thermal_setField(T,dot_T, ce) integer, intent(in) :: ce - real(pReal), intent(in) :: T, dot_T + real(pReal), intent(in) :: T, dot_T current(material_homogenizationID(ce))%T(material_homogenizationEntry(ce)) = T @@ -187,6 +185,7 @@ module subroutine thermal_results(ho,group) integer :: o + associate(prm => param(ho)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) diff --git a/src/phase.f90 b/src/phase.f90 index af7197f7b..1403fef22 100644 --- a/src/phase.f90 +++ b/src/phase.f90 @@ -626,9 +626,10 @@ function crystallite_push33ToRef(co,ce, tensor33) ce real(pReal), dimension(3,3) :: crystallite_push33ToRef - real(pReal), dimension(3,3) :: T + real(pReal), dimension(3,3) :: T integer :: ph, en + ph = material_phaseID(co,ce) en = material_phaseEntry(co,ce) T = matmul(phase_O_0(ph)%data(en)%asMatrix(),transpose(math_inv33(phase_F(co,ce)))) ! ToDo: initial orientation correct? diff --git a/src/phase_damage.f90 b/src/phase_damage.f90 index 82d94150d..7211f2db5 100644 --- a/src/phase_damage.f90 +++ b/src/phase_damage.f90 @@ -4,8 +4,9 @@ submodule(phase) damage type :: tDamageParameters - real(pReal) :: mu = 0.0_pReal !< viscosity - real(pReal), dimension(3,3) :: D = 0.0_pReal !< conductivity/diffusivity + real(pReal) :: & + mu = 0.0_pReal, & !< viscosity + l_c = 0.0_pReal !< characteristic length end type tDamageParameters enum, bind(c); enumerator :: & @@ -104,8 +105,8 @@ module subroutine damage_init if (sources%length == 1) then damage_active = .true. source => sources%get(1) - param(ph)%mu = source%get_asFloat('mu') - param(ph)%D = math_I3 * source%get_asFloat('l_c')**2 + param(ph)%mu = source%get_asFloat('mu') + param(ph)%l_c = source%get_asFloat('l_c') end if end do @@ -117,7 +118,7 @@ module subroutine damage_init where(anisobrittle_init()) phase_damage = DAMAGE_ANISOBRITTLE_ID end if - phase_damage_maxSizeDotState = maxval(damageState%sizeDotState) + phase_damage_maxSizeDotState = maxval(damageState%sizeDotState) end subroutine damage_init @@ -157,9 +158,9 @@ module function phase_damage_C66(C66,ph,en) result(C66_degraded) damageType: select case (phase_damage(ph)) case (DAMAGE_ISOBRITTLE_ID) damageType - C66_degraded = C66 * damage_phi(ph,en)**2 + C66_degraded = C66 * damage_phi(ph,en)**2 case default damageType - C66_degraded = C66 + C66_degraded = C66 end select damageType end function phase_damage_C66 @@ -385,7 +386,7 @@ module function phase_K_phi(co,ce) result(K) real(pReal), dimension(3,3) :: K - K = crystallite_push33ToRef(co,ce,param(material_phaseID(co,ce))%D) + K = crystallite_push33ToRef(co,ce,param(material_phaseID(co,ce))%l_c**2*math_I3) end function phase_K_phi diff --git a/src/phase_thermal.f90 b/src/phase_thermal.f90 index 0f5836df9..ed374e142 100644 --- a/src/phase_thermal.f90 +++ b/src/phase_thermal.f90 @@ -4,8 +4,8 @@ submodule(phase) thermal type :: tThermalParameters - real(pReal) :: C_p = 0.0_pReal !< heat capacity - real(pReal), dimension(3,3) :: K = 0.0_pReal !< thermal conductivity + real(pReal) :: C_p = 0.0_pReal !< heat capacity + real(pReal), dimension(3,3) :: K = 0.0_pReal !< thermal conductivity character(len=pStringLen), allocatable, dimension(:) :: output end type tThermalParameters @@ -72,7 +72,7 @@ submodule(phase) thermal contains !---------------------------------------------------------------------------------------------- -!< @brief initializes thermal sources and kinematics mechanism +!< @brief Initializes thermal sources and kinematics mechanism. !---------------------------------------------------------------------------------------------- module subroutine thermal_init(phases) @@ -146,7 +146,7 @@ end subroutine thermal_init !---------------------------------------------------------------------------------------------- -!< @brief calculates thermal dissipation rate +!< @brief Calculate thermal source. !---------------------------------------------------------------------------------------------- module function phase_f_T(ph,en) result(f) @@ -176,7 +176,7 @@ end function phase_f_T !-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!> @brief tbd. !-------------------------------------------------------------------------------------------------- function phase_thermal_collectDotState(ph,en) result(broken) @@ -216,7 +216,7 @@ end function phase_mu_T !-------------------------------------------------------------------------------------------------- -!> @brief Thermal conductivity/diffusivity in reference configuration. +!> @brief Thermal conductivity in reference configuration. !-------------------------------------------------------------------------------------------------- module function phase_K_T(co,ce) result(K) @@ -255,6 +255,7 @@ function integrateThermalState(Delta_t, ph,en) result(broken) so, & sizeDotState + broken = phase_thermal_collectDotState(ph,en) if (broken) return From a90b78de62ae83216cfa5dcfb1852d442beb5bf0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 24 Jun 2022 09:22:17 +0200 Subject: [PATCH 66/99] testing isotropic heat equation --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index b14f78e96..646039bcf 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit b14f78e96a8e2986aaf6845b98ea77fec92bc997 +Subproject commit 646039bcf85760e92112eccb60b92b4125a28ed2 From 372b9b04afc235f48674600ce9917c9ef923a7f7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 27 Jun 2022 09:59:05 +0200 Subject: [PATCH 67/99] avoid failing tests by ignoring solution of mechanical field --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 646039bcf..a561f30a9 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 646039bcf85760e92112eccb60b92b4125a28ed2 +Subproject commit a561f30a96c5b90e220b905a24c9d54acd479497 From 3b57934d6e3d615fba38665a47a46cebd578ea24 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 27 Jun 2022 08:37:41 +0000 Subject: [PATCH 68/99] Marc precision handling --- CMakeLists.txt | 2 +- cmake/Compiler-GNU.cmake | 7 -- cmake/Compiler-Intel.cmake | 5 - cmake/Compiler-IntelLLVM.cmake | 5 - src/Marc/DAMASK_Marc.f90 | 24 ++--- src/grid/DAMASK_grid.f90 | 4 +- src/grid/VTI.f90 | 2 +- src/grid/discretization_grid.f90 | 6 +- src/grid/grid_mech_FEM.f90 | 20 ++-- src/grid/spectral_utilities.f90 | 28 +++--- src/homogenization_mechanical_RGC.f90 | 6 +- src/lattice.f90 | 8 +- src/math.f90 | 4 +- src/mesh/FEM_utilities.f90 | 2 +- src/mesh/discretization_mesh.f90 | 2 +- src/mesh/mesh_mech_FEM.f90 | 102 ++++++++++----------- src/phase_mechanical.f90 | 6 +- src/phase_mechanical_plastic_dislotwin.f90 | 4 +- src/rotations.f90 | 2 +- 19 files changed, 108 insertions(+), 131 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index d24d9b8b8..6827d31b8 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -108,7 +108,7 @@ file(STRINGS "$ENV{PETSC_DIR}/$ENV{PETSC_ARCH}/lib/petsc/conf/petscvariables" PE string(REPLACE "PETSC_FC_INCLUDES = " "" PETSC_INCLUDES "${PETSC_INCLUDES}") message("PETSC_INCLUDES:\n${PETSC_INCLUDES}\n") -set(CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${BUILDCMD_PRE} ${OPENMP_FLAGS} ${STANDARD_CHECK} ${OPTIMIZATION_FLAGS} ${COMPILE_FLAGS} ${PRECISION_FLAGS}") +set(CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${BUILDCMD_PRE} ${OPENMP_FLAGS} ${STANDARD_CHECK} ${OPTIMIZATION_FLAGS} ${COMPILE_FLAGS}") set(CMAKE_Fortran_LINK_EXECUTABLE "${BUILDCMD_PRE} ${CMAKE_Fortran_COMPILER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}") if(CMAKE_BUILD_TYPE STREQUAL "DEBUG") diff --git a/cmake/Compiler-GNU.cmake b/cmake/Compiler-GNU.cmake index 6eedffc21..397d1277b 100644 --- a/cmake/Compiler-GNU.cmake +++ b/cmake/Compiler-GNU.cmake @@ -135,10 +135,3 @@ set (DEBUG_FLAGS "${DEBUG_FLAGS} -fsanitize=undefined") # detect undefined behavior # Additional options # -fsanitize=address,leak,thread - -#------------------------------------------------------------------------------------------------ -# precision settings -set (PRECISION_FLAGS "${PRECISION_FLAGS} -fdefault-real-8") -# set precision to 8 bytes for standard real (=8 for pReal). Will set size of double to 16 bytes as long as -fdefault-double-8 is not set -set (PRECISION_FLAGS "${PRECISION_FLAGS} -fdefault-double-8") -# set precision to 8 bytes for double real, would be 16 bytes if -fdefault-real-8 is used diff --git a/cmake/Compiler-Intel.cmake b/cmake/Compiler-Intel.cmake index 7f34e4a13..4125aa8ef 100644 --- a/cmake/Compiler-Intel.cmake +++ b/cmake/Compiler-Intel.cmake @@ -118,8 +118,3 @@ set (DEBUG_FLAGS "${DEBUG_FLAGS} -debug all") # -check: Checks at runtime, where # arg_temp_created: will cause a lot of warnings because we create a bunch of temporary arrays (performance?) # stack: - -#------------------------------------------------------------------------------------------------ -# precision settings -set (PRECISION_FLAGS "${PRECISION_FLAGS} -real-size 64") -# set precision for standard real to 32 | 64 | 128 (= 4 | 8 | 16 bytes, type pReal is always 8 bytes) diff --git a/cmake/Compiler-IntelLLVM.cmake b/cmake/Compiler-IntelLLVM.cmake index 883873e1c..bd0f07ee8 100644 --- a/cmake/Compiler-IntelLLVM.cmake +++ b/cmake/Compiler-IntelLLVM.cmake @@ -117,8 +117,3 @@ set (DEBUG_FLAGS "${DEBUG_FLAGS} -debug all") # -check: Checks at runtime, where # arg_temp_created: will cause a lot of warnings because we create a bunch of temporary arrays (performance?) # stack: - -#------------------------------------------------------------------------------------------------ -# precision settings -set (PRECISION_FLAGS "${PRECISION_FLAGS} -real-size 64") -# set precision for standard real to 32 | 64 | 128 (= 4 | 8 | 16 bytes, type pReal is always 8 bytes) diff --git a/src/Marc/DAMASK_Marc.f90 b/src/Marc/DAMASK_Marc.f90 index 28cdf9223..3cfaf7741 100644 --- a/src/Marc/DAMASK_Marc.f90 +++ b/src/Marc/DAMASK_Marc.f90 @@ -211,7 +211,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & use OMP_LIB implicit none - integer, intent(in) :: & ! according to MSC.Marc 2012 Manual D + integer(pI64), intent(in) :: & ! according to MSC.Marc 2012 Manual D ngens, & !< size of stress-strain law nn, & !< integration point number ndi, & !< number of direct components @@ -224,7 +224,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & jtype, & !< element type ifr, & !< set to 1 if R has been calculated ifu !< set to 1 if stretch has been calculated - integer, dimension(2), intent(in) :: & ! according to MSC.Marc 2012 Manual D + integer(pI64), dimension(2), intent(in) :: & ! according to MSC.Marc 2012 Manual D m, & !< (1) user element number, (2) internal element number matus, & !< (1) user material identification number, (2) internal material identification number kcus, & !< (1) layer number, (2) internal layer number @@ -362,7 +362,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & endif lastLovl = lovl - call materialpoint_general(computationMode,ffn,ffn1,t(1),timinc,m(1),nn,stress,ddsdde) + call materialpoint_general(computationMode,ffn,ffn1,t(1),timinc,int(m(1)),int(nn),stress,ddsdde) d = ddsdde(1:ngens,1:ngens) s = stress(1:ndi+nshear) @@ -383,16 +383,17 @@ subroutine flux(f,ts,n,time) use discretization_Marc implicit none - real(pReal), dimension(6), intent(in) :: & + real(pReal), dimension(6), intent(in) :: & ts - integer, dimension(10), intent(in) :: & + integer(pI64), dimension(10), intent(in) :: & n - real(pReal), intent(in) :: & + real(pReal), intent(in) :: & time - real(pReal), dimension(2), intent(out) :: & + real(pReal), dimension(2), intent(out) :: & f - f(1) = homogenization_f_T(discretization_Marc_FEM2DAMASK_cell(n(3),n(1))) + + f(1) = homogenization_f_T(discretization_Marc_FEM2DAMASK_cell(int(n(3)),int(n(1)))) f(2) = 0.0_pReal end subroutine flux @@ -410,7 +411,8 @@ subroutine uedinc(inc,incsub) use discretization_Marc implicit none - integer, intent(in) :: inc, incsub + integer(pI64), intent(in) :: inc, incsub + integer :: n, nqncomp, nqdatatype integer, save :: inc_written real(pReal), allocatable, dimension(:,:) :: d_n @@ -427,9 +429,9 @@ subroutine uedinc(inc,incsub) enddo call discretization_Marc_UpdateNodeAndIpCoords(d_n) - call materialpoint_results(inc,cptim) + call materialpoint_results(int(inc),cptim) - inc_written = inc + inc_written = int(inc) endif end subroutine uedinc diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 0d41338a1..0f16d33aa 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -272,7 +272,7 @@ program DAMASK_grid write(IO_STDOUT,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'R:',& transpose(loadCases(l)%rot%asMatrix()) - if (loadCases(l)%r <= 0.0) errorID = 833 + if (loadCases(l)%r <= 0.0_pReal) errorID = 833 if (loadCases(l)%t < 0.0_pReal) errorID = 834 if (loadCases(l)%N < 1) errorID = 835 if (loadCases(l)%f_out < 1) errorID = 836 @@ -501,7 +501,7 @@ subroutine getMaskedTensor(values,mask,tensor) integer :: i,j - values = 0.0 + values = 0.0_pReal do i = 1,3 row => tensor%get(i) do j = 1,3 diff --git a/src/grid/VTI.f90 b/src/grid/VTI.f90 index a5918137e..53be9f022 100644 --- a/src/grid/VTI.f90 +++ b/src/grid/VTI.f90 @@ -151,7 +151,7 @@ subroutine VTI_readCellsSizeOrigin(cells,geomSize,origin, & character(len=*), intent(in) :: & fileContent - character(len=:), allocatable :: dataType, headerType + character(len=:), allocatable :: headerType logical :: inFile, inImage, compressed integer(pI64) :: & startPos, endPos diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 916cf6e69..2bac30f0a 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -229,9 +229,9 @@ pure function cellSurfaceArea(geomSize,cells) real(pReal), dimension(6,1,product(cells)) :: cellSurfaceArea - cellSurfaceArea(1:2,1,:) = geomSize(2)/real(cells(2)) * geomSize(3)/real(cells(3)) - cellSurfaceArea(3:4,1,:) = geomSize(3)/real(cells(3)) * geomSize(1)/real(cells(1)) - cellSurfaceArea(5:6,1,:) = geomSize(1)/real(cells(1)) * geomSize(2)/real(cells(2)) + cellSurfaceArea(1:2,1,:) = geomSize(2)/real(cells(2),pReal) * geomSize(3)/real(cells(3),pReal) + cellSurfaceArea(3:4,1,:) = geomSize(3)/real(cells(3),pReal) * geomSize(1)/real(cells(1),pReal) + cellSurfaceArea(5:6,1,:) = geomSize(1)/real(cells(1),pReal) * geomSize(2)/real(cells(2),pReal) end function cellSurfaceArea diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 52be43362..405b10845 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -221,14 +221,14 @@ subroutine grid_mechanical_FEM_init delta = geomSize/real(cells,pReal) ! grid spacing detJ = product(delta) ! cell volume - BMat = reshape(real([-1.0_pReal/delta(1),-1.0_pReal/delta(2),-1.0_pReal/delta(3), & - 1.0_pReal/delta(1),-1.0_pReal/delta(2),-1.0_pReal/delta(3), & - -1.0_pReal/delta(1), 1.0_pReal/delta(2),-1.0_pReal/delta(3), & - 1.0_pReal/delta(1), 1.0_pReal/delta(2),-1.0_pReal/delta(3), & - -1.0_pReal/delta(1),-1.0_pReal/delta(2), 1.0_pReal/delta(3), & - 1.0_pReal/delta(1),-1.0_pReal/delta(2), 1.0_pReal/delta(3), & - -1.0_pReal/delta(1), 1.0_pReal/delta(2), 1.0_pReal/delta(3), & - 1.0_pReal/delta(1), 1.0_pReal/delta(2), 1.0_pReal/delta(3)],pReal), [3,8])/4.0_pReal ! shape function derivative matrix + BMat = reshape(real([-delta(1)**(-1),-delta(2)**(-1),-delta(3)**(-1), & + delta(1)**(-1),-delta(2)**(-1),-delta(3)**(-1), & + -delta(1)**(-1), delta(2)**(-1),-delta(3)**(-1), & + delta(1)**(-1), delta(2)**(-1),-delta(3)**(-1), & + -delta(1)**(-1),-delta(2)**(-1), delta(3)**(-1), & + delta(1)**(-1),-delta(2)**(-1), delta(3)**(-1), & + -delta(1)**(-1), delta(2)**(-1), delta(3)**(-1), & + delta(1)**(-1), delta(2)**(-1), delta(3)**(-1)],pReal), [3,8])/4.0_pReal ! shape function derivative matrix HGMat = matmul(transpose(HGcomp),HGcomp) & * HGCoeff*(delta(1)*delta(2) + delta(2)*delta(3) + delta(3)*delta(1))/16.0_pReal ! hourglass stabilization matrix @@ -656,7 +656,7 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,err_PETSc) MatNullSpace :: matnull PetscErrorCode :: err_PETSc - BMatFull = 0.0 + BMatFull = 0.0_pReal BMatFull(1:3,1 :8 ) = BMat BMatFull(4:6,9 :16) = BMat BMatFull(7:9,17:24) = BMat @@ -686,7 +686,7 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,err_PETSc) enddo; enddo; enddo row = col ce = ce + 1 - K_ele = 0.0 + K_ele = 0.0_pReal K_ele(1 :8 ,1 :8 ) = HGMat*(homogenization_dPdF(1,1,1,1,ce) + & homogenization_dPdF(2,2,2,2,ce) + & homogenization_dPdF(3,3,3,3,ce))/3.0_pReal diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 2e00c10f4..8835545f9 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -198,7 +198,7 @@ subroutine spectral_utilities_init() CHKERRQ(err_PETSc) cells1Red = cells(1)/2 + 1 - wgt = 1.0/real(product(cells),pReal) + wgt = real(product(cells),pReal)**(-1) num%memory_efficient = num_grid%get_asInt('memory_efficient', defaultVal=1) > 0 ! ToDo: should be logical in YAML file num%divergence_correction = num_grid%get_asInt('divergence_correction', defaultVal=2) @@ -265,7 +265,7 @@ subroutine spectral_utilities_init() N = fftw_mpi_local_size_many(3,[cellsFFTW(3),cellsFFTW(2),cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T],& tensorSize,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD,z,devNull) - if (z /= cells3) error stop 'domain decomposition mismatch (tensor)' + if (int(z) /= cells3) error stop 'domain decomposition mismatch (tensor)' tensorField = fftw_alloc_complex(N) call c_f_pointer(tensorField,tensorField_real, & [3_C_INTPTR_T,3_C_INTPTR_T,2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) @@ -274,7 +274,7 @@ subroutine spectral_utilities_init() N = fftw_mpi_local_size_many(3,[cellsFFTW(3),cellsFFTW(2),cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T],& vectorSize,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD,z,devNull) - if (z /= cells3) error stop 'domain decomposition mismatch (vector)' + if (int(z) /= cells3) error stop 'domain decomposition mismatch (vector)' vectorField = fftw_alloc_complex(N) call c_f_pointer(vectorField,vectorField_real, & [3_C_INTPTR_T,2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) @@ -283,7 +283,7 @@ subroutine spectral_utilities_init() N = fftw_mpi_local_size_3d(cellsFFTW(3),cellsFFTW(2),cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T,& PETSC_COMM_WORLD,z,devNull) - if (z /= cells3) error stop 'domain decomposition mismatch (scalar)' + if (int(z) /= cells3) error stop 'domain decomposition mismatch (scalar)' scalarField = fftw_alloc_complex(N) call c_f_pointer(scalarField,scalarField_real, & [2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) @@ -385,17 +385,17 @@ subroutine utilities_updateGamma(C) xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k-cells3Offset))*xi1st(m,i,j,k-cells3Offset) end do do concurrent(l = 1:3, m = 1:3) - temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx) + temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx) end do #else forall(l = 1:3, m = 1:3) & xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k-cells3Offset))*xi1st(m,i,j,k-cells3Offset) forall(l = 1:3, m = 1:3) & - temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx) + temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx) #endif A(1:3,1:3) = temp33_cmplx%re; A(4:6,4:6) = temp33_cmplx%re A(1:3,4:6) = temp33_cmplx%im; A(4:6,1:3) = -temp33_cmplx%im - if (abs(math_det33(A(1:3,1:3))) > 1e-16) then + if (abs(math_det33(A(1:3,1:3))) > 1.e-16_pReal) then call math_invert(A_inv, err, A) temp33_cmplx = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pReal) #ifndef __INTEL_COMPILER @@ -518,17 +518,17 @@ subroutine utilities_fourierGammaConvolution(fieldAim) xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k))*xi1st(m,i,j,k) end do do concurrent(l = 1:3, m = 1:3) - temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx) + temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx) end do #else forall(l = 1:3, m = 1:3) & xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k))*xi1st(m,i,j,k) forall(l = 1:3, m = 1:3) & - temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx) + temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx) #endif A(1:3,1:3) = temp33_cmplx%re; A(4:6,4:6) = temp33_cmplx%re A(1:3,4:6) = temp33_cmplx%im; A(4:6,1:3) = -temp33_cmplx%im - if (abs(math_det33(A(1:3,1:3))) > 1e-16) then + if (abs(math_det33(A(1:3,1:3))) > 1.e-16_pReal) then call math_invert(A_inv, err, A) temp33_cmplx = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pReal) #ifndef __INTEL_COMPILER @@ -587,8 +587,8 @@ subroutine utilities_fourierGreenConvolution(D_ref, mu_ref, Delta_t) !$OMP PARALLEL DO PRIVATE(GreenOp_hat) do k = 1, cells3; do j = 1, cells(2) ;do i = 1, cells1Red GreenOp_hat = cmplx(1.0_pReal,0.0_pReal,pReal) & - / (cmplx(mu_ref,0.0_pReal,pReal) + cmplx(Delta_t,0.0_pReal) & - * sum(conjg(xi1st(1:3,i,j,k))* matmul(cmplx(D_ref,0.0_pReal),xi1st(1:3,i,j,k)))) + / (cmplx(mu_ref,0.0_pReal,pReal) + cmplx(Delta_t,0.0_pReal,pReal) & + * sum(conjg(xi1st(1:3,i,j,k))* matmul(cmplx(D_ref,0.0_pReal,pReal),xi1st(1:3,i,j,k)))) scalarField_fourier(i,j,k) = scalarField_fourier(i,j,k)*GreenOp_hat enddo; enddo; enddo !$OMP END PARALLEL DO @@ -608,7 +608,7 @@ real(pReal) function utilities_divergenceRMS() print'(/,1x,a)', '... calculating divergence ................................................' flush(IO_STDOUT) - rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal) + rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal,pReal) !-------------------------------------------------------------------------------------------------- ! calculating RMS divergence criterion in Fourier space @@ -652,7 +652,7 @@ real(pReal) function utilities_curlRMS() print'(/,1x,a)', '... calculating curl ......................................................' flush(IO_STDOUT) - rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal) + rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal,pReal) !-------------------------------------------------------------------------------------------------- ! calculating max curl criterion in Fourier space diff --git a/src/homogenization_mechanical_RGC.f90 b/src/homogenization_mechanical_RGC.f90 index c74b9fb6c..4bacefe7e 100644 --- a/src/homogenization_mechanical_RGC.f90 +++ b/src/homogenization_mechanical_RGC.f90 @@ -601,9 +601,9 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy) ! calculate the stress and penalty due to volume discrepancy vPen = 0.0_pReal do i = 1,nGrain - vPen(:,:,i) = -1.0_pReal/real(nGrain,pReal)*num%volDiscrMod*num%volDiscrPow/num%maxVolDiscr* & - sign((abs(vDiscrep)/num%maxVolDiscr)**(num%volDiscrPow - 1.0),vDiscrep)* & - gVol(i)*transpose(math_inv33(fDef(:,:,i))) + vPen(:,:,i) = -real(nGrain,pReal)**(-1)*num%volDiscrMod*num%volDiscrPow/num%maxVolDiscr & + * sign((abs(vDiscrep)/num%maxVolDiscr)**(num%volDiscrPow - 1.0_pReal),vDiscrep) & + * gVol(i)*transpose(math_inv33(fDef(:,:,i))) end do end subroutine volumePenalty diff --git a/src/lattice.f90 b/src/lattice.f90 index 1496deb78..f8182191b 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -2008,7 +2008,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI) ],pReal),shape(CFTOHP_SYSTEMTRANS)) real(pReal), dimension(4,cF_Ntrans), parameter :: & - CFTOCI_SYSTEMTRANS = reshape([& + CFTOCI_SYSTEMTRANS = real(reshape([& 0.0, 1.0, 0.0, 10.26, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) 0.0,-1.0, 0.0, 10.26, & 0.0, 0.0, 1.0, 10.26, & @@ -2021,7 +2021,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI) -1.0, 0.0, 0.0, 10.26, & 0.0, 1.0, 0.0, 10.26, & 0.0,-1.0, 0.0, 10.26 & - ],shape(CFTOCI_SYSTEMTRANS)) + ],shape(CFTOCI_SYSTEMTRANS)),pReal) integer, dimension(9,cF_Ntrans), parameter :: & CFTOCI_BAINVARIANT = reshape( [& @@ -2040,7 +2040,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI) ],shape(CFTOCI_BAINVARIANT)) real(pReal), dimension(4,cF_Ntrans), parameter :: & - CFTOCI_BAINROT = reshape([& + CFTOCI_BAINROT = real(reshape([& 1.0, 0.0, 0.0, 45.0, & ! Rotate cF austensite to bain variant 1.0, 0.0, 0.0, 45.0, & 1.0, 0.0, 0.0, 45.0, & @@ -2053,7 +2053,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI) 0.0, 0.0, 1.0, 45.0, & 0.0, 0.0, 1.0, 45.0, & 0.0, 0.0, 1.0, 45.0 & - ],shape(CFTOCI_BAINROT)) + ],shape(CFTOCI_BAINROT)),pReal) if (present(a_cI) .and. present(a_cF)) then do i = 1,sum(Ntrans) diff --git a/src/math.f90 b/src/math.f90 index 882706ea7..bd74d6e82 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -1110,7 +1110,7 @@ pure function math_rotationalPart(F) result(R) C = matmul(transpose(F),F) I_C = math_invariantsSym33(C) - I_F = [math_trace33(F), 0.5*(math_trace33(F)**2 - math_trace33(matmul(F,F)))] + I_F = [math_trace33(F), 0.5_pReal*(math_trace33(F)**2 - math_trace33(matmul(F,F)))] x = math_clip(I_C(1)**2 -3.0_pReal*I_C(2),0.0_pReal)**(3.0_pReal/2.0_pReal) if (dNeq0(x)) then @@ -1386,7 +1386,7 @@ subroutine selfTest() call random_number(v3_3) call random_number(v3_4) - if (dNeq(abs(dot_product(math_cross(v3_1-v3_4,v3_2-v3_4),v3_3-v3_4))/6.0, & + if (dNeq(abs(dot_product(math_cross(v3_1-v3_4,v3_2-v3_4),v3_3-v3_4))/6.0_pReal, & math_volTetrahedron(v3_1,v3_2,v3_3,v3_4),tol=1.0e-12_pReal)) & error stop 'math_volTetrahedron' diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 4e31a0475..0b633bef7 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -131,7 +131,7 @@ subroutine FEM_utilities_init call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsOrder),err_PETSc) CHKERRQ(err_PETSc) - wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal) + wgt = real(mesh_maxNips*mesh_NcpElemsGlobal,pReal)**(-1) end subroutine FEM_utilities_init diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index b898c4e6b..206d6b5bc 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -247,7 +247,7 @@ subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints) mesh_ipCoordinates(dirI,qPt,cell+1) = pV0(dirI) do dirJ = 1, dimPlex mesh_ipCoordinates(dirI,qPt,cell+1) = mesh_ipCoordinates(dirI,qPt,cell+1) + & - pCellJ((dirI-1)*dimPlex+dirJ)*(qPoints(qOffset+dirJ) + 1.0) + pCellJ((dirI-1)*dimPlex+dirJ)*(qPoints(qOffset+dirJ) + 1.0_pReal) enddo enddo qOffset = qOffset + dimPlex diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index 5f02011eb..4ba3f2690 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -230,14 +230,14 @@ subroutine FEM_mechanical_init(fieldBC) CHKERRQ(err_PETSc) call SNESSetConvergenceTest(mechanical_snes,FEM_mechanical_converged,PETSC_NULL_VEC,PETSC_NULL_FUNCTION,err_PETSc) CHKERRQ(err_PETSc) - call SNESSetTolerances(mechanical_snes,1.0,0.0,0.0,num%itmax,num%itmax,err_PETSc) + call SNESSetTolerances(mechanical_snes,1.0_pReal,0.0_pReal,0.0_pReal,num%itmax,num%itmax,err_PETSc) CHKERRQ(err_PETSc) call SNESSetFromOptions(mechanical_snes,err_PETSc); CHKERRQ(err_PETSc) !-------------------------------------------------------------------------------------------------- ! init fields - call VecSet(solution ,0.0,err_PETSc); CHKERRQ(err_PETSc) - call VecSet(solution_rate ,0.0,err_PETSc); CHKERRQ(err_PETSc) + call VecSet(solution ,0.0_pReal,err_PETSc); CHKERRQ(err_PETSc) + call VecSet(solution_rate,0.0_pReal,err_PETSc); CHKERRQ(err_PETSc) allocate(x_scal(cellDof)) allocate(nodalWeightsP(1)) allocate(nodalPointsP(dimPlex)) @@ -338,11 +338,10 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc PetscInt :: cellStart, cellEnd, cell, field, face, & qPt, basis, comp, cidx, & numFields, & - bcSize,m + bcSize,m,i PetscReal :: detFAvg, detJ PetscReal, dimension(dimPlex*dimPlex,cellDof) :: BMat - - IS :: bcPoints + IS :: bcPoints allocate(pV0(dimPlex)) @@ -358,7 +357,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc CHKERRQ(err_PETSc) call DMGetLocalVector(dm_local,x_local,err_PETSc) CHKERRQ(err_PETSc) - call VecWAXPY(x_local,1.0,xx_local,solution_local,err_PETSc) + call VecWAXPY(x_local,1.0_pReal,xx_local,solution_local,err_PETSc) CHKERRQ(err_PETSc) do field = 1, dimPlex; do face = 1, mesh_Nboundaries if (params%fieldBC%componentBC(field)%Mask(face)) then @@ -386,23 +385,23 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex]) do qPt = 0, nQuadrature-1 m = cell*nQuadrature + qPt+1 - BMat = 0.0 + BMat = 0.0_pReal do basis = 0, nBasis-1 do comp = 0, dimPlex-1 cidx = basis*dimPlex+comp - BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = & - matmul(IcellJMat,basisFieldDer((((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp )*dimPlex+1: & - (((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex)) + i = ((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp + BMat(comp*dimPlex+1_pPETSCINT:(comp+1_pPETSCINT)*dimPlex,basis*dimPlex+comp+1_pPETSCINT) = & + matmul(IcellJMat,basisFieldDer(i*dimPlex+1_pPETSCINT:(i+1_pPETSCINT)*dimPlex)) enddo enddo homogenization_F(1:dimPlex,1:dimPlex,m) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1]) enddo if (num%BBarStabilisation) then - detFAvg = math_det33(sum(homogenization_F(1:3,1:3,cell*nQuadrature+1:(cell+1)*nQuadrature),dim=3)/real(nQuadrature)) + detFAvg = math_det33(sum(homogenization_F(1:3,1:3,cell*nQuadrature+1:(cell+1)*nQuadrature),dim=3)/real(nQuadrature,pReal)) do qPt = 0, nQuadrature-1 m = cell*nQuadrature + qPt+1 homogenization_F(1:dimPlex,1:dimPlex,m) = homogenization_F(1:dimPlex,1:dimPlex,m) & - * (detFAvg/math_det33(homogenization_F(1:3,1:3,m)))**(1.0/real(dimPlex)) + * (detFAvg/math_det33(homogenization_F(1:3,1:3,m)))**(1.0_pReal/real(dimPlex,pReal)) enddo endif @@ -425,22 +424,22 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,err_PETSc) CHKERRQ(err_PETSc) IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex]) - f_scal = 0.0 + f_scal = 0.0_pReal do qPt = 0, nQuadrature-1 m = cell*nQuadrature + qPt+1 - BMat = 0.0 + BMat = 0.0_pReal do basis = 0, nBasis-1 do comp = 0, dimPlex-1 cidx = basis*dimPlex+comp - BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = & - matmul(IcellJMat,basisFieldDer((((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp )*dimPlex+1: & - (((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex)) + i = ((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp + BMat(comp*dimPlex+1_pPETSCINT:(comp+1_pPETSCINT)*dimPlex,basis*dimPlex+comp+1_pPETSCINT) = & + matmul(IcellJMat,basisFieldDer(i*dimPlex+1_pPETSCINT:(i+1_pPETSCINT)*dimPlex)) enddo enddo - f_scal = f_scal + & - matmul(transpose(BMat), & - reshape(transpose(homogenization_P(1:dimPlex,1:dimPlex,m)), & - shape=[dimPlex*dimPlex]))*qWeights(qPt+1) + f_scal = f_scal & + + matmul(transpose(BMat), & + reshape(transpose(homogenization_P(1:dimPlex,1:dimPlex,m)), & + shape=[dimPlex*dimPlex]))*qWeights(qPt+1_pPETSCINT) enddo f_scal = f_scal*abs(detJ) pf_scal => f_scal @@ -465,28 +464,25 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P PetscObject, intent(in) :: dummy PetscErrorCode :: err_PETSc - PetscDS :: prob - Vec :: x_local, xx_local - - PetscSection :: section, gSection + PetscDS :: prob + Vec :: x_local, xx_local + PetscSection :: section, gSection PetscReal, dimension(1, cellDof) :: MatB PetscReal, dimension(dimPlex**2,cellDof) :: BMat, BMatAvg, MatA - PetscReal, dimension(3,3) :: F, FAvg, FInv - PetscReal :: detJ - PetscReal, dimension(:), pointer :: basisField, basisFieldDer, & + PetscReal, dimension(3,3) :: F, FAvg, FInv + PetscReal :: detJ + PetscReal, dimension(:), pointer :: basisField, basisFieldDer, & pV0, pCellJ, pInvcellJ PetscScalar, dimension(:), pointer :: pK_e, x_scal PetscScalar,dimension(cellDOF,cellDOF), target :: K_e - PetscScalar,dimension(cellDOF,cellDOF) :: K_eA , & - K_eB + PetscScalar,dimension(cellDOF,cellDOF) :: K_eA, K_eB - PetscInt :: cellStart, cellEnd, cell, field, face, & - qPt, basis, comp, cidx,bcSize, m - - IS :: bcPoints + PetscInt :: cellStart, cellEnd, cell, field, face, & + qPt, basis, comp, cidx,bcSize, m, i + IS :: bcPoints allocate(pV0(dimPlex)) @@ -530,30 +526,29 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P CHKERRQ(err_PETSc) call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,err_PETSc) CHKERRQ(err_PETSc) - K_eA = 0.0 - K_eB = 0.0 - MatB = 0.0 - FAvg = 0.0 - BMatAvg = 0.0 + K_eA = 0.0_pReal + K_eB = 0.0_pReal + MatB = 0.0_pReal + FAvg = 0.0_pReal + BMatAvg = 0.0_pReal do qPt = 0, nQuadrature-1 m = cell*nQuadrature + qPt + 1 - BMat = 0.0 + BMat = 0.0_pReal do basis = 0, nBasis-1 do comp = 0, dimPlex-1 cidx = basis*dimPlex+comp - BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = & - matmul( reshape(pInvcellJ, shape = [dimPlex,dimPlex]),& - basisFieldDer((((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp )*dimPlex+1: & - (((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex)) + i = ((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp + BMat(comp*dimPlex+1_pPETSCINT:(comp+1_pPETSCINT)*dimPlex,basis*dimPlex+comp+1_pPETSCINT) = & + matmul(reshape(pInvcellJ,[dimPlex,dimPlex]),basisFieldDer(i*dimPlex+1_pPETSCINT:(i+1_pPETSCINT)*dimPlex)) enddo enddo MatA = matmul(reshape(reshape(homogenization_dPdF(1:dimPlex,1:dimPlex,1:dimPlex,1:dimPlex,m), & shape=[dimPlex,dimPlex,dimPlex,dimPlex], order=[2,1,4,3]), & - shape=[dimPlex*dimPlex,dimPlex*dimPlex]),BMat)*qWeights(qPt+1) + shape=[dimPlex*dimPlex,dimPlex*dimPlex]),BMat)*qWeights(qPt+1_pPETSCINT) if (num%BBarStabilisation) then F(1:dimPlex,1:dimPlex) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex]) FInv = math_inv33(F) - K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0/real(dimPlex)) + K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0_pReal/real(dimPlex,pReal)) K_eB = K_eB - & matmul(transpose(matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,m),shape=[dimPlex**2,1_pPETSCINT]), & matmul(reshape(FInv(1:dimPlex,1:dimPlex), & @@ -568,10 +563,10 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P enddo if (num%BBarStabilisation) then FInv = math_inv33(FAvg) - K_e = K_eA*math_det33(FAvg/real(nQuadrature))**(1.0/real(dimPlex)) + & + K_e = K_eA*math_det33(FAvg/real(nQuadrature,pReal))**(1.0_pReal/real(dimPlex,pReal)) + & (matmul(matmul(transpose(BMatAvg), & reshape(FInv(1:dimPlex,1:dimPlex),shape=[dimPlex**2,1_pPETSCINT],order=[2,1])),MatB) + & - K_eB)/real(dimPlex) + K_eB)/real(dimPlex,pReal) else K_e = K_eA endif @@ -641,7 +636,7 @@ subroutine FEM_mechanical_forward(guess,timeinc,timeinc_old,fieldBC) CHKERRQ(err_PETSc) call DMGlobalToLocalEnd(dm_local,solution,INSERT_VALUES,x_local,err_PETSc) CHKERRQ(err_PETSc) - call VecAXPY(solution_local,1.0,x_local,err_PETSc); CHKERRQ(err_PETSc) + call VecAXPY(solution_local,1.0_pReal,x_local,err_PETSc); CHKERRQ(err_PETSc) do field = 1, dimPlex; do face = 1, mesh_Nboundaries if (fieldBC%componentBC(field)%Mask(face)) then call DMGetStratumSize(dm_local,'Face Sets',mesh_boundaries(face),bcSize,err_PETSc) @@ -659,7 +654,7 @@ subroutine FEM_mechanical_forward(guess,timeinc,timeinc_old,fieldBC) !-------------------------------------------------------------------------------------------------- ! update rate and forward last inc call VecCopy(solution,solution_rate,err_PETSc); CHKERRQ(err_PETSc) - call VecScale(solution_rate,1.0/timeinc_old,err_PETSc); CHKERRQ(err_PETSc) + call VecScale(solution_rate,timeinc_old**(-1),err_PETSc); CHKERRQ(err_PETSc) endif call VecCopy(solution_rate,solution,err_PETSc); CHKERRQ(err_PETSc) call VecScale(solution,timeinc,err_PETSc); CHKERRQ(err_PETSc) @@ -685,9 +680,8 @@ subroutine FEM_mechanical_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reaso call SNESConvergedDefault(snes_local,PETScIter,xnorm,snorm,fnorm/divTol,reason,dummy,err_PETSc) CHKERRQ(err_PETSc) if (terminallyIll) reason = SNES_DIVERGED_FUNCTION_DOMAIN - print'(/,1x,a,a,i0,a,i0,f0.3)', trim(incInfo), & - ' @ Iteration ',PETScIter,' mechanical residual norm = ', & - int(fnorm/divTol),fnorm/divTol-int(fnorm/divTol) ! ToDo: int casting? + print'(/,1x,a,a,i0,a,f0.3)', trim(incInfo), & + ' @ Iteration ',PETScIter,' mechanical residual norm = ',fnorm/divTol print'(/,1x,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', & 'Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pReal flush(IO_STDOUT) diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90 index afde549fc..a6e18595a 100644 --- a/src/phase_mechanical.f90 +++ b/src/phase_mechanical.f90 @@ -593,7 +593,7 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b iteration: do NiterationState = 1, num%nState - dotState_last(1:sizeDotState,2) = merge(dotState_last(1:sizeDotState,1),0.0, nIterationState > 1) + dotState_last(1:sizeDotState,2) = merge(dotState_last(1:sizeDotState,1),0.0_pReal, nIterationState > 1) dotState_last(1:sizeDotState,1) = dotState broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en) @@ -756,7 +756,7 @@ function integrateStateRK4(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b real(pReal), dimension(3), parameter :: & C = [0.5_pReal, 0.5_pReal, 1.0_pReal] real(pReal), dimension(4), parameter :: & - B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] + B = [6.0_pReal, 3.0_pReal, 3.0_pReal, 6.0_pReal]**(-1) broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C) @@ -1263,8 +1263,6 @@ module subroutine mechanical_restartRead(groupHandle,ph) integer(HID_T), intent(in) :: groupHandle integer, intent(in) :: ph - integer :: en - call HDF5_read(plasticState(ph)%state0,groupHandle,'omega_plastic') call HDF5_read(phase_mechanical_S0(ph)%data,groupHandle,'S') diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index a29efeb56..6642b6c98 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -912,7 +912,7 @@ pure subroutine kinetics_tw(Mp,T,abs_dot_gamma_sl,ph,en,& real(pReal), dimension(param(ph)%sum_N_tw), optional, intent(out) :: & ddot_gamma_dtau_tw - real :: & + real(pReal) :: & tau, tau_r, tau_hat, & dot_N_0, & x0, V, & @@ -988,7 +988,7 @@ pure subroutine kinetics_tr(Mp,T,abs_dot_gamma_sl,ph,en,& real(pReal), dimension(param(ph)%sum_N_tr), optional, intent(out) :: & ddot_gamma_dtau_tr - real :: & + real(pReal) :: & tau, tau_r, tau_hat, & dot_N_0, & x0, V, & diff --git a/src/rotations.f90 b/src/rotations.f90 index d548404c9..ee938676c 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -801,7 +801,7 @@ subroutine selfTest() real(pReal), dimension(3,3) :: om, t33 real(pReal), dimension(3,3,3,3) :: t3333 real(pReal), dimension(6,6) :: C - real :: A,B + real(pReal) :: A,B integer :: i From bd49cfeb318af77e511a64bbd51a397bf523e2b1 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 27 Jun 2022 12:59:19 +0200 Subject: [PATCH 69/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-483-gde89d0fe3 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 12c5e4193..45349346b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-476-gac626db9d +3.0.0-alpha6-483-gde89d0fe3 From de1633f420d48f44b577d982936a2a256d3a5612 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 27 Jun 2022 21:51:44 +0200 Subject: [PATCH 70/99] limit access --- src/grid/spectral_utilities.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 8835545f9..1c8842a60 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -34,12 +34,12 @@ module spectral_utilities !-------------------------------------------------------------------------------------------------- ! variables storing information for spectral method and FFTW - real (C_DOUBLE), public, dimension(:,:,:,:,:), pointer :: tensorField_real !< real representation (some stress or deformation) of field_fourier - complex(C_DOUBLE_COMPLEX),public, dimension(:,:,:,:,:), pointer :: tensorField_fourier !< field on which the Fourier transform operates - real(C_DOUBLE), public, dimension(:,:,:,:), pointer :: vectorField_real !< vector field real representation for fftw - complex(C_DOUBLE_COMPLEX),public, dimension(:,:,:,:), pointer :: vectorField_fourier !< vector field fourier representation for fftw - real(C_DOUBLE), public, dimension(:,:,:), pointer :: scalarField_real !< scalar field real representation for fftw - complex(C_DOUBLE_COMPLEX),public, dimension(:,:,:), pointer :: scalarField_fourier !< scalar field fourier representation for fftw + real(C_DOUBLE), public, dimension(:,:,:,:,:), pointer :: tensorField_real !< tensor field in real space + real(C_DOUBLE), public, dimension(:,:,:,:), pointer :: vectorField_real !< vector field in real space + real(C_DOUBLE), public, dimension(:,:,:), pointer :: scalarField_real !< scalar field in real space + complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:,:), pointer :: tensorField_fourier !< tensor field in Fourier space + complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), pointer :: vectorField_fourier !< tensor field in Fourier space + complex(C_DOUBLE_COMPLEX), dimension(:,:,:), pointer :: scalarField_fourier !< tensor field in Fourier space complex(pReal), dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat !< gamma operator (field) for spectral method complex(pReal), dimension(:,:,:,:), allocatable :: xi1st !< wave vector field for first derivatives complex(pReal), dimension(:,:,:,:), allocatable :: xi2nd !< wave vector field for second derivatives From 60e097a04e3e763ba717b73ed19285ddd136f90a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 27 Jun 2022 22:35:29 +0200 Subject: [PATCH 71/99] something is wrong with interfaces for 64 bit --- src/mesh/FEM_utilities.f90 | 2 +- src/mesh/discretization_mesh.f90 | 9 ++++++--- src/mesh/mesh_mech_FEM.f90 | 2 +- 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 3bdf901e5..c97c2bbe2 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -69,7 +69,7 @@ module FEM_utilities type(tComponentBC), allocatable, dimension(:) :: componentBC end type tFieldBC - external :: & + external :: & ! ToDo: write interfaces PetscSectionGetFieldComponents, & PetscSectionGetFieldDof, & PetscSectionGetFieldOffset diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index bbb125887..a53c50655 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -57,6 +57,9 @@ module discretization_mesh mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) external :: & +#ifdef PETSC_USE_64BIT_INDICES + DMDestroy, & +#endif DMView ! ToDo: write interface public :: & discretization_mesh_init, & @@ -248,10 +251,10 @@ subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints) call DMPlexComputeCellGeometryAffineFEM(geomMesh,cell,pV0,pCellJ,pInvcellJ,detJ,err_PETSc) CHKERRQ(err_PETSc) qOffset = 0 - do qPt = 1, mesh_maxNips - do dirI = 1, dimPlex + do qPt = 1_pPETSCINT, mesh_maxNips + do dirI = 1_pPETSCINT, dimPlex mesh_ipCoordinates(dirI,qPt,cell+1) = pV0(dirI) - do dirJ = 1, dimPlex + do dirJ = 1_pPETSCINT, dimPlex mesh_ipCoordinates(dirI,qPt,cell+1) = mesh_ipCoordinates(dirI,qPt,cell+1) + & pCellJ((dirI-1)*dimPlex+dirJ)*(qPoints(qOffset+dirJ) + 1.0_pReal) enddo diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index fae906891..e60d0213c 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -71,7 +71,7 @@ module mesh_mechanical_FEM logical :: ForwardData real(pReal), parameter :: eps = 1.0e-18_pReal - external :: & + external :: & ! ToDo: write interfaces PetscSectionGetNumFields, & PetscFESetQuadrature, & PetscFEGetDimension, & From 64fad03b97d74a3823f0c066e0326b44e51816cc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 27 Jun 2022 23:39:54 +0200 Subject: [PATCH 72/99] explicit casting --- src/mesh/mesh_mech_FEM.f90 | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index e60d0213c..3b162d97b 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -72,6 +72,9 @@ module mesh_mechanical_FEM real(pReal), parameter :: eps = 1.0e-18_pReal external :: & ! ToDo: write interfaces +#ifdef PETSC_USE_64BIT_INDICES + ISDestroy, & +#endif PetscSectionGetNumFields, & PetscFESetQuadrature, & PetscFEGetDimension, & @@ -372,7 +375,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc CHKERRQ(err_PETSc) call VecWAXPY(x_local,1.0_pReal,xx_local,solution_local,err_PETSc) CHKERRQ(err_PETSc) - do field = 1, dimPlex; do face = 1, mesh_Nboundaries + do field = 1_pPETSCINT, dimPlex; do face = 1_pPETSCINT, mesh_Nboundaries if (params%fieldBC%componentBC(field)%Mask(face)) then call DMGetStratumSize(dm_local,'Face Sets',mesh_boundaries(face),bcSize,err_PETSc) if (bcSize > 0) then @@ -387,7 +390,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc !-------------------------------------------------------------------------------------------------- ! evaluate field derivatives - do cell = cellStart, cellEnd-1 !< loop over all elements + do cell = cellStart, cellEnd-1_pPETSCINT !< loop over all elements call PetscSectionGetNumFields(section,numFields,err_PETSc) CHKERRQ(err_PETSc) @@ -396,11 +399,11 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,err_PETSc) CHKERRQ(err_PETSc) IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex]) - do qPt = 0, nQuadrature-1 - m = cell*nQuadrature + qPt+1 + do qPt = 0_pPETSCINT, nQuadrature-1_pPETSCINT + m = cell*nQuadrature + qPt+1_pPETSCINT BMat = 0.0_pReal - do basis = 0, nBasis-1 - do comp = 0, dimPlex-1 + do basis = 0_pPETSCINT, nBasis-1_pPETSCINT + do comp = 0_pPETSCINT, dimPlex-1_pPETSCINT cidx = basis*dimPlex+comp i = ((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp BMat(comp*dimPlex+1_pPETSCINT:(comp+1_pPETSCINT)*dimPlex,basis*dimPlex+comp+1_pPETSCINT) = & @@ -438,11 +441,11 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc CHKERRQ(err_PETSc) IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex]) f_scal = 0.0_pReal - do qPt = 0, nQuadrature-1 - m = cell*nQuadrature + qPt+1 + do qPt = 0_pPETSCINT, nQuadrature-1_pPETSCINT + m = cell*nQuadrature + qPt+1_pPETSCINT BMat = 0.0_pReal - do basis = 0, nBasis-1 - do comp = 0, dimPlex-1 + do basis = 0_pPETSCINT, nBasis-1_pPETSCINT + do comp = 0_pPETSCINT, dimPlex-1_pPETSCINT cidx = basis*dimPlex+comp i = ((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp BMat(comp*dimPlex+1_pPETSCINT:(comp+1_pPETSCINT)*dimPlex,basis*dimPlex+comp+1_pPETSCINT) = & @@ -544,11 +547,11 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P MatB = 0.0_pReal FAvg = 0.0_pReal BMatAvg = 0.0_pReal - do qPt = 0, nQuadrature-1 - m = cell*nQuadrature + qPt + 1 + do qPt = 0_pPETSCINT, nQuadrature-1_pPETSCINT + m = cell*nQuadrature + qPt + 1_pPETSCINT BMat = 0.0_pReal - do basis = 0, nBasis-1 - do comp = 0, dimPlex-1 + do basis = 0_pPETSCINT, nBasis-1_pPETSCINT + do comp = 0_pPETSCINT, dimPlex-1_pPETSCINT cidx = basis*dimPlex+comp i = ((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp BMat(comp*dimPlex+1_pPETSCINT:(comp+1_pPETSCINT)*dimPlex,basis*dimPlex+comp+1_pPETSCINT) = & @@ -754,7 +757,7 @@ subroutine FEM_mechanical_updateCoords() call PetscDSGetTabulation(mechQuad,0_pPETSCINT,basisField,basisFieldDer,err_PETSc) CHKERRQ(err_PETSc) allocate(ipCoords(3,nQuadrature,mesh_NcpElems),source=0.0_pReal) - do c=cellStart,cellEnd-1 + do c=cellStart,cellEnd-1_pPETSCINT qOffset=0 call DMPlexVecGetClosure(dm_local,section,x_local,c,x_scal,err_PETSc) !< get nodal coordinates of each element CHKERRQ(err_PETSc) From b51f4faabef38e52aa2ee4f5fe165dae22a0411c Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 28 Jun 2022 12:04:40 +0200 Subject: [PATCH 73/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-486-gba1d6ad07 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 45349346b..b372336e3 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-483-gde89d0fe3 +3.0.0-alpha6-486-gba1d6ad07 From 1d1f460d66aada542c531953f46c68db6a2c471a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 Jun 2022 20:00:39 +0200 Subject: [PATCH 74/99] original layout from official page GitHub has issues identifying the license, maybe this helps --- LICENSE | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/LICENSE b/LICENSE index 8f9664407..11b05b50f 100644 --- a/LICENSE +++ b/LICENSE @@ -1,9 +1,9 @@ Copyright 2011-2022 Max-Planck-Institut für Eisenforschung GmbH DAMASK is free software: you can redistribute it and/or modify -it under the terms of the GNU Affero General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. +it under the terms of the GNU Affero General Public License as +published by the Free Software Foundation, either version 3 of the +License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of From a4ffdbe96970d46d8a6fd69f265ce8140a880766 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 28 Jun 2022 22:21:06 +0200 Subject: [PATCH 75/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-488-g1d1f460d6 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index b372336e3..d1f0960c7 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-486-gba1d6ad07 +3.0.0-alpha6-488-g1d1f460d6 From ef8f0becd43e8e5652e41296cf499593e2507c47 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 30 Jun 2022 21:45:49 +0200 Subject: [PATCH 76/99] only used within module --- src/grid/spectral_utilities.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 1c8842a60..6bd30f590 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -28,8 +28,8 @@ module spectral_utilities !-------------------------------------------------------------------------------------------------- ! grid related information real(pReal), protected, public :: wgt !< weighting factor 1/Nelems - integer, protected, public :: cells1Red !< cells(1)/2 real(pReal), protected, public, dimension(3) :: scaledGeomSize !< scaled geometry size for calculation of divergence + integer :: cells1Red !< cells(1)/2+1 !-------------------------------------------------------------------------------------------------- ! variables storing information for spectral method and FFTW From af2eb3e51da0e2b01d9bd2e0586678cf75dcee6e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 30 Jun 2022 21:59:21 +0200 Subject: [PATCH 77/99] systematic names --- src/grid/spectral_utilities.f90 | 34 ++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 6bd30f590..4d9504b25 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -150,7 +150,7 @@ subroutine spectral_utilities_init() vectorField, & !< field containing data for FFTW in real space when debugging FFTW (no in place) scalarField !< field containing data for FFTW in real space when debugging FFTW (no in place) integer(C_INTPTR_T), dimension(3) :: cellsFFTW - integer(C_INTPTR_T) :: N, z, devNull + integer(C_INTPTR_T) :: N, cells3FFTW, cells3_offset integer(C_INTPTR_T), parameter :: & vectorSize = 3_C_INTPTR_T, & tensorSize = 9_C_INTPTR_T @@ -263,32 +263,32 @@ subroutine spectral_utilities_init() cellsFFTW = int(cells,C_INTPTR_T) - N = fftw_mpi_local_size_many(3,[cellsFFTW(3),cellsFFTW(2),cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T],& - tensorSize,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD,z,devNull) - if (int(z) /= cells3) error stop 'domain decomposition mismatch (tensor)' + N = fftw_mpi_local_size_many(3,[cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T)],& + tensorSize,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD,cells3FFTW,cells3_offset) + if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (tensor)' tensorField = fftw_alloc_complex(N) call c_f_pointer(tensorField,tensorField_real, & - [3_C_INTPTR_T,3_C_INTPTR_T,2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) + [3_C_INTPTR_T,3_C_INTPTR_T,int(cells1Red*2,C_INTPTR_T),cellsFFTW(2),cells3FFTW]) call c_f_pointer(tensorField,tensorField_fourier, & - [3_C_INTPTR_T,3_C_INTPTR_T, cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T, cellsFFTW(2),z]) + [3_C_INTPTR_T,3_C_INTPTR_T,int(cells1Red, C_INTPTR_T),cellsFFTW(2),cells3FFTW]) - N = fftw_mpi_local_size_many(3,[cellsFFTW(3),cellsFFTW(2),cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T],& - vectorSize,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD,z,devNull) - if (int(z) /= cells3) error stop 'domain decomposition mismatch (vector)' + N = fftw_mpi_local_size_many(3,[cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T)],& + vectorSize,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD,cells3FFTW,cells3_offset) + if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (vector)' vectorField = fftw_alloc_complex(N) call c_f_pointer(vectorField,vectorField_real, & - [3_C_INTPTR_T,2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) + [3_C_INTPTR_T,int(cells1Red*2,C_INTPTR_T),cellsFFTW(2),cells3FFTW]) call c_f_pointer(vectorField,vectorField_fourier, & - [3_C_INTPTR_T, cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T, cellsFFTW(2),z]) + [3_C_INTPTR_T,int(cells1Red, C_INTPTR_T),cellsFFTW(2),cells3FFTW]) - N = fftw_mpi_local_size_3d(cellsFFTW(3),cellsFFTW(2),cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T,& - PETSC_COMM_WORLD,z,devNull) - if (int(z) /= cells3) error stop 'domain decomposition mismatch (scalar)' + N = fftw_mpi_local_size_3d(cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T),& + PETSC_COMM_WORLD,cells3FFTW,cells3_offset) + if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (scalar)' scalarField = fftw_alloc_complex(N) call c_f_pointer(scalarField,scalarField_real, & - [2_C_INTPTR_T*(cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T),cellsFFTW(2),z]) + [int(cells1Red*2,C_INTPTR_T),cellsFFTW(2),cells3FFTW]) call c_f_pointer(scalarField,scalarField_fourier, & - [ cellsFFTW(1)/2_C_INTPTR_T+1_C_INTPTR_T, cellsFFTW(2),z]) + [int(cells1Red, C_INTPTR_T),cellsFFTW(2),cells3FFTW]) !-------------------------------------------------------------------------------------------------- ! tensor MPI fftw plans @@ -585,7 +585,7 @@ subroutine utilities_fourierGreenConvolution(D_ref, mu_ref, Delta_t) !-------------------------------------------------------------------------------------------------- ! do the actual spectral method calculation !$OMP PARALLEL DO PRIVATE(GreenOp_hat) - do k = 1, cells3; do j = 1, cells(2) ;do i = 1, cells1Red + do k = 1, cells3; do j = 1, cells(2); do i = 1, cells1Red GreenOp_hat = cmplx(1.0_pReal,0.0_pReal,pReal) & / (cmplx(mu_ref,0.0_pReal,pReal) + cmplx(Delta_t,0.0_pReal,pReal) & * sum(conjg(xi1st(1:3,i,j,k))* matmul(cmplx(D_ref,0.0_pReal,pReal),xi1st(1:3,i,j,k)))) From 44ecedc7b0a216b683afe05e4a103f26859c7abf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 30 Jun 2022 22:01:35 +0200 Subject: [PATCH 78/99] unified names --- src/grid/spectral_utilities.f90 | 55 +++++++++++++++++---------------- 1 file changed, 28 insertions(+), 27 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 4d9504b25..f6b8b3c2b 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -224,16 +224,16 @@ subroutine spectral_utilities_init() do j = 1, 3 if (j /= minloc(geomSize,1) .and. j /= maxloc(geomSize,1)) & scaledGeomSize = geomSize/geomSize(j) - enddo + end do elseif (num%divergence_correction == 2) then do j = 1, 3 if ( j /= int(minloc(geomSize/real(cells,pReal),1)) & .and. j /= int(maxloc(geomSize/real(cells,pReal),1))) & scaledGeomSize = geomSize/geomSize(j)*real(cells(j),pReal) - enddo + end do else scaledGeomSize = geomSize - endif + end if select case(IO_lc(num_grid%get_asString('fftw_plan_mode',defaultVal='FFTW_MEASURE'))) case('fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution @@ -344,13 +344,13 @@ subroutine spectral_utilities_init() elsewhere xi1st(1:3,i,j,k-cells3Offset) = xi2nd(1:3,i,j,k-cells3Offset) endwhere - enddo; enddo; enddo + end do; end do; end do if (num%memory_efficient) then ! allocate just single fourth order tensor allocate (gamma_hat(3,3,3,3,1,1,1), source = cmplx(0.0_pReal,0.0_pReal,pReal)) else ! precalculation of gamma_hat field allocate (gamma_hat(3,3,3,3,cells1Red,cells(2),cells3), source = cmplx(0.0_pReal,0.0_pReal,pReal)) - endif + end if call selfTest() @@ -410,7 +410,7 @@ subroutine utilities_updateGamma(C) end if end do; end do; end do !$OMP END PARALLEL DO - endif + end if end subroutine utilities_updateGamma @@ -590,7 +590,7 @@ subroutine utilities_fourierGreenConvolution(D_ref, mu_ref, Delta_t) / (cmplx(mu_ref,0.0_pReal,pReal) + cmplx(Delta_t,0.0_pReal,pReal) & * sum(conjg(xi1st(1:3,i,j,k))* matmul(cmplx(D_ref,0.0_pReal,pReal),xi1st(1:3,i,j,k)))) scalarField_fourier(i,j,k) = scalarField_fourier(i,j,k)*GreenOp_hat - enddo; enddo; enddo + end do; end do; end do !$OMP END PARALLEL DO end subroutine utilities_fourierGreenConvolution @@ -605,6 +605,7 @@ real(pReal) function utilities_divergenceRMS() integer(MPI_INTEGER_KIND) :: err_MPI complex(pReal), dimension(3) :: rescaledGeom + print'(/,1x,a)', '... calculating divergence ................................................' flush(IO_STDOUT) @@ -620,7 +621,7 @@ real(pReal) function utilities_divergenceRMS() conjg(-xi1st(1:3,i,j,k))*rescaledGeom))**2) & ! --> sum squared L_2 norm of vector +sum(aimag(matmul(tensorField_fourier(1:3,1:3,i,j,k),& conjg(-xi1st(1:3,i,j,k))*rescaledGeom))**2)) - enddo + end do utilities_divergenceRMS = utilities_divergenceRMS & ! these two layers (DC and Nyquist) do not have a conjugate complex counterpart (if cells(1) /= 1) + sum( real(matmul(tensorField_fourier(1:3,1:3,1 ,j,k), & conjg(-xi1st(1:3,1,j,k))*rescaledGeom))**2) & @@ -630,7 +631,7 @@ real(pReal) function utilities_divergenceRMS() conjg(-xi1st(1:3,cells1Red,j,k))*rescaledGeom))**2) & + sum(aimag(matmul(tensorField_fourier(1:3,1:3,cells1Red,j,k), & conjg(-xi1st(1:3,cells1Red,j,k))*rescaledGeom))**2) - enddo; enddo + end do; end do if (cells(1) == 1) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pReal ! counted twice in case of cells(1) == 1 call MPI_Allreduce(MPI_IN_PLACE,utilities_divergenceRMS,1_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' @@ -667,10 +668,10 @@ real(pReal) function utilities_curlRMS() -tensorField_fourier(l,3,i,j,k)*xi1st(1,i,j,k)*rescaledGeom(1)) curl_fourier(l,3) = (+tensorField_fourier(l,2,i,j,k)*xi1st(1,i,j,k)*rescaledGeom(1) & -tensorField_fourier(l,1,i,j,k)*xi1st(2,i,j,k)*rescaledGeom(2)) - enddo + end do utilities_curlRMS = utilities_curlRMS & +2.0_pReal*sum(curl_fourier%re**2+curl_fourier%im**2) ! Has somewhere a conj. complex counterpart. Therefore count it twice. - enddo + end do do l = 1, 3 curl_fourier = (+tensorField_fourier(l,3,1,j,k)*xi1st(2,1,j,k)*rescaledGeom(2) & -tensorField_fourier(l,2,1,j,k)*xi1st(3,1,j,k)*rescaledGeom(3)) @@ -678,7 +679,7 @@ real(pReal) function utilities_curlRMS() -tensorField_fourier(l,3,1,j,k)*xi1st(1,1,j,k)*rescaledGeom(1)) curl_fourier = (+tensorField_fourier(l,2,1,j,k)*xi1st(1,1,j,k)*rescaledGeom(1) & -tensorField_fourier(l,1,1,j,k)*xi1st(2,1,j,k)*rescaledGeom(2)) - enddo + end do utilities_curlRMS = utilities_curlRMS & + sum(curl_fourier%re**2 + curl_fourier%im**2) ! this layer (DC) does not have a conjugate complex counterpart (if cells(1) /= 1) do l = 1, 3 @@ -688,10 +689,10 @@ real(pReal) function utilities_curlRMS() -tensorField_fourier(l,3,cells1Red,j,k)*xi1st(1,cells1Red,j,k)*rescaledGeom(1)) curl_fourier = (+tensorField_fourier(l,2,cells1Red,j,k)*xi1st(1,cells1Red,j,k)*rescaledGeom(1) & -tensorField_fourier(l,1,cells1Red,j,k)*xi1st(2,cells1Red,j,k)*rescaledGeom(2)) - enddo + end do utilities_curlRMS = utilities_curlRMS & + sum(curl_fourier%re**2 + curl_fourier%im**2) ! this layer (Nyquist) does not have a conjugate complex counterpart (if cells(1) /= 1) - enddo; enddo + end do; end do call MPI_Allreduce(MPI_IN_PLACE,utilities_curlRMS,1_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' @@ -733,11 +734,11 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) print'(/,1x,a,/,8(9(2x,f12.7,1x)/),9(2x,f12.7,1x))', & 'Stiffness C (load) / GPa =', transpose(temp99_Real)*1.0e-9_pReal flush(IO_STDOUT) - endif + end if do i = 1,9; do j = 1,9 mask(i,j) = mask_stressVector(i) .and. mask_stressVector(j) - enddo; enddo + end do; end do c_reduced = reshape(pack(temp99_Real,mask),[size_reduced,size_reduced]) allocate(s_reduced,mold = c_reduced) @@ -754,11 +755,11 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) print trim(formatString), 'C * S (load) ', transpose(matmul(c_reduced,s_reduced)) print trim(formatString), 'S (load) ', transpose(s_reduced) if (errmatinv) error stop 'matrix inversion error' - endif + end if temp99_real = reshape(unpack(reshape(s_reduced,[size_reduced**2]),reshape(mask,[81]),0.0_pReal),[9,9]) else temp99_real = 0.0_pReal - endif + end if utilities_maskedCompliance = math_99to3333(temp99_Real) @@ -766,7 +767,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) print'(/,1x,a,/,9(9(2x,f10.5,1x)/),9(2x,f10.5,1x))', & 'Masked Compliance (load) * GPa =', transpose(temp99_Real)*1.0e9_pReal flush(IO_STDOUT) - endif + end if end function utilities_maskedCompliance @@ -880,12 +881,12 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& if (dPdF_norm_max < sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2)) then dPdF_max = homogenization_dPdF(1:3,1:3,1:3,1:3,i) dPdF_norm_max = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2) - endif + end if if (dPdF_norm_min > sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2)) then dPdF_min = homogenization_dPdF(1:3,1:3,1:3,1:3,i) dPdF_norm_min = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2) - endif - enddo + end if + end do valueAndRank = [dPdF_norm_max,real(worldrank,pReal)] call MPI_Allreduce(MPI_IN_PLACE,valueAndRank,1_MPI_INTEGER_KIND,MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_WORLD,err_MPI) @@ -961,7 +962,7 @@ function utilities_forwardField(Delta_t,field_lastInc,rate,aim) fieldDiff = fieldDiff - aim utilities_forwardField = utilities_forwardField - & spread(spread(spread(fieldDiff,3,cells(1)),4,cells(2)),5,cells3) - endif + end if end function utilities_forwardField @@ -1115,15 +1116,15 @@ subroutine utilities_updateCoords(F) me = [i+neighbor(1,n),j+neighbor(2,n),k+neighbor(3,n)] nodeCoords(1:3,i+1,j+1,k+1) = nodeCoords(1:3,i+1,j+1,k+1) & + IPfluct_padded(1:3,modulo(me(1)-1,cells(1))+1,modulo(me(2)-1,cells(2))+1,me(3)+1)*0.125_pReal - enddo averageFluct - enddo; enddo; enddo + end do averageFluct + end do; end do; end do !-------------------------------------------------------------------------------------------------- ! calculate cell center displacements do k = 1,cells3; do j = 1,cells(2); do i = 1,cells(1) IPcoords(1:3,i,j,k) = vectorField_real(1:3,i,j,k) & + matmul(Favg,step*(real([i,j,k+cells3Offset],pReal)-0.5_pReal)) - enddo; enddo; enddo + end do; end do; end do call discretization_setNodeCoords(reshape(NodeCoords,[3,(cells(1)+1)*(cells(2)+1)*(cells3+1)])) call discretization_setIPcoords (reshape(IPcoords, [3,cells(1)*cells(2)*cells3])) @@ -1146,7 +1147,7 @@ subroutine utilities_saveReferenceStiffness if (ierr /=0) call IO_error(100,ext_msg='could not open file '//getSolverJobName()//'.C_ref') write(fileUnit) C_ref close(fileUnit) - endif + end if end subroutine utilities_saveReferenceStiffness From fc76f9f60fbbfbcbb6a3e65f0cde07b749733773 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 30 Jun 2022 22:23:27 +0200 Subject: [PATCH 79/99] preparing for use of transposed data in Fourier space --- src/grid/spectral_utilities.f90 | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index f6b8b3c2b..4cab79c81 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -146,11 +146,15 @@ subroutine spectral_utilities_init() FFTW_planner_flag integer, dimension(3) :: k_s type(C_PTR) :: & - tensorField, & !< field containing data for FFTW in real and fourier space (in place) - vectorField, & !< field containing data for FFTW in real space when debugging FFTW (no in place) - scalarField !< field containing data for FFTW in real space when debugging FFTW (no in place) + tensorField, & !< tensor data for FFTW in real and Fourier space (in-place) + vectorField, & !< vector data for FFTW in real and Fourier space (in-place) + scalarField !< scalar data for FFTW in real and Fourier space (in-place) integer(C_INTPTR_T), dimension(3) :: cellsFFTW - integer(C_INTPTR_T) :: N, cells3FFTW, cells3_offset + integer(C_INTPTR_T) :: N, & + cells3FFTW, & !< # of cells in 3. dim on current process in real space + cells3_offset, & !< offset for cells in 3. dim on current process in real space + cells2FFTW, & !< # of cells in 2. dim on current process in Fourier space + cells2_offset !< offset for cells in 2. dim on curren process in Fourier space integer(C_INTPTR_T), parameter :: & vectorSize = 3_C_INTPTR_T, & tensorSize = 9_C_INTPTR_T @@ -158,7 +162,7 @@ subroutine spectral_utilities_init() PETSCDEBUG = ' -snes_view -snes_monitor ' class(tNode) , pointer :: & num_grid, & - debug_grid ! pointer to grid debug options + debug_grid ! pointer to grid debug options print'(/,1x,a)', '<<<+- spectral_utilities init -+>>>' @@ -263,8 +267,9 @@ subroutine spectral_utilities_init() cellsFFTW = int(cells,C_INTPTR_T) - N = fftw_mpi_local_size_many(3,[cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T)],& - tensorSize,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD,cells3FFTW,cells3_offset) + N = fftw_mpi_local_size_many_transposed(3,[cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T)], & + tensorSize,FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD, & + cells3FFTW,cells3_offset,cells2FFTW,cells2_offset) if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (tensor)' tensorField = fftw_alloc_complex(N) call c_f_pointer(tensorField,tensorField_real, & @@ -272,8 +277,9 @@ subroutine spectral_utilities_init() call c_f_pointer(tensorField,tensorField_fourier, & [3_C_INTPTR_T,3_C_INTPTR_T,int(cells1Red, C_INTPTR_T),cellsFFTW(2),cells3FFTW]) - N = fftw_mpi_local_size_many(3,[cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T)],& - vectorSize,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD,cells3FFTW,cells3_offset) + N = fftw_mpi_local_size_many_transposed(3,[cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T)], & + vectorSize,FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD, & + cells3FFTW,cells3_offset,cells2FFTW,cells2_offset) if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (vector)' vectorField = fftw_alloc_complex(N) call c_f_pointer(vectorField,vectorField_real, & @@ -281,8 +287,8 @@ subroutine spectral_utilities_init() call c_f_pointer(vectorField,vectorField_fourier, & [3_C_INTPTR_T,int(cells1Red, C_INTPTR_T),cellsFFTW(2),cells3FFTW]) - N = fftw_mpi_local_size_3d(cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T),& - PETSC_COMM_WORLD,cells3FFTW,cells3_offset) + N = fftw_mpi_local_size_3d_transposed(cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T), & + PETSC_COMM_WORLD,cells3FFTW,cells3_offset,cells2FFTW,cells2_offset) if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (scalar)' scalarField = fftw_alloc_complex(N) call c_f_pointer(scalarField,scalarField_real, & From 771ccb44852a844cd264d84baefa546901840285 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jul 2022 14:33:10 +0200 Subject: [PATCH 80/99] testing average behavior --- src/grid/spectral_utilities.f90 | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 4cab79c81..bcf4d54de 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -955,19 +955,21 @@ function utilities_forwardField(Delta_t,field_lastInc,rate,aim) rate !< rate by which to forward real(pReal), intent(in), optional, dimension(3,3) :: & aim !< average field value aim + real(pReal), dimension(3,3,cells(1),cells(2),cells3) :: & utilities_forwardField - real(pReal), dimension(3,3) :: fieldDiff !< - aim + real(pReal), dimension(3,3) :: fieldDiff !< - aim integer(MPI_INTEGER_KIND) :: err_MPI + utilities_forwardField = field_lastInc + rate*Delta_t if (present(aim)) then !< correct to match average fieldDiff = sum(sum(sum(utilities_forwardField,dim=5),dim=4),dim=3)*wgt call MPI_Allreduce(MPI_IN_PLACE,fieldDiff,9_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' fieldDiff = fieldDiff - aim - utilities_forwardField = utilities_forwardField - & - spread(spread(spread(fieldDiff,3,cells(1)),4,cells(2)),5,cells3) + utilities_forwardField = utilities_forwardField & + - spread(spread(spread(fieldDiff,3,cells(1)),4,cells(2)),5,cells3) end if end function utilities_forwardField @@ -981,8 +983,10 @@ end function utilities_forwardField pure function utilities_getFreqDerivative(k_s) integer, intent(in), dimension(3) :: k_s !< indices of frequency + complex(pReal), dimension(3) :: utilities_getFreqDerivative + select case (spectral_derivative_ID) case (DERIVATIVE_CONTINUOUS_ID) utilities_getFreqDerivative = cmplx(0.0_pReal, TAU*real(k_s,pReal)/geomSize,pReal) @@ -1082,7 +1086,7 @@ subroutine utilities_updateCoords(F) !-------------------------------------------------------------------------------------------------- ! average F - if (cells3Offset == 0) Favg = real(tensorField_fourier(1:3,1:3,1,1,1),pReal)*wgt + if (cells3Offset == 0) Favg = tensorField_fourier(1:3,1:3,1,1,1)%re*wgt call MPI_Bcast(Favg,9_MPI_INTEGER_KIND,MPI_DOUBLE,0_MPI_INTEGER_KIND,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' @@ -1146,6 +1150,7 @@ subroutine utilities_saveReferenceStiffness integer :: & fileUnit,ierr + if (worldrank == 0) then print'(/,1x,a)', '... writing reference stiffness data required for restart to file .........'; flush(IO_STDOUT) open(newunit=fileUnit, file=getSolverJobName()//'.C_ref',& @@ -1172,6 +1177,10 @@ subroutine selfTest() tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal tensorField_real_ = tensorField_real call utilities_FFTtensorForward() + if (worldsize==1) then + if (any(dNeq(sum(sum(sum(tensorField_real_,dim=5),dim=4),dim=3)/tensorField_fourier(:,:,1,1,1)%re,1.0_pReal,1.0e-12_pReal))) & + error stop 'tensorField avg' + endif call utilities_FFTtensorBackward() tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal if (maxval(abs(tensorField_real_ - tensorField_real))>5.0e-15_pReal) error stop 'tensorField' @@ -1180,6 +1189,10 @@ subroutine selfTest() vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal vectorField_real_ = vectorField_real call utilities_FFTvectorForward() + if (worldsize==1) then + if (any(dNeq(sum(sum(sum(vectorField_real_,dim=4),dim=3),dim=2)/vectorField_fourier(:,1,1,1)%re,1.0_pReal,1.0e-12_pReal))) & + error stop 'vector avg' + endif call utilities_FFTvectorBackward() vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal if (maxval(abs(vectorField_real_ - vectorField_real))>5.0e-15_pReal) error stop 'vectorField' @@ -1188,6 +1201,10 @@ subroutine selfTest() scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pReal scalarField_real_ = scalarField_real call utilities_FFTscalarForward() + if (worldsize==1) then + if (dNeq(sum(sum(sum(scalarField_real_,dim=3),dim=2),dim=1)/scalarField_fourier(1,1,1)%re,1.0_pReal,1.0e-12_pReal)) & + error stop 'scalar avg' + endif call utilities_FFTscalarBackward() scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pReal if (maxval(abs(scalarField_real_ - scalarField_real))>5.0e-15_pReal) error stop 'scalarField' From c3ba8b6588c2c625f0d1b1014394a9149cc8f279 Mon Sep 17 00:00:00 2001 From: Sharan Date: Sat, 2 Jul 2022 18:59:21 +0200 Subject: [PATCH 81/99] dot state is 0 in isibrittle --- src/phase_damage_isobrittle.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/phase_damage_isobrittle.f90 b/src/phase_damage_isobrittle.f90 index 36f26abd3..76b382d62 100644 --- a/src/phase_damage_isobrittle.f90 +++ b/src/phase_damage_isobrittle.f90 @@ -75,7 +75,7 @@ module function isobrittle_init() result(mySources) if (prm%W_crit <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit' Nmembers = count(material_phaseID==ph) - call phase_allocateState(damageState(ph),Nmembers,1,1,1) + call phase_allocateState(damageState(ph),Nmembers,1,0,1) damageState(ph)%atol = src%get_asFloat('atol_phi',defaultVal=1.0e-9_pReal) if (any(damageState(ph)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' atol_phi' From 725ae601f9f77b049133f12208c873657dcb5f86 Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 3 Jul 2022 19:03:54 +0200 Subject: [PATCH 82/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-491-g9f4fc1527 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index d1f0960c7..58979f3c7 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-488-g1d1f460d6 +3.0.0-alpha6-491-g9f4fc1527 From ec0c486a2c310744da5a497f4348010670df0c39 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 6 Jul 2022 12:32:05 +0200 Subject: [PATCH 83/99] transition to transposed storage --- src/grid/spectral_utilities.f90 | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index bcf4d54de..bdde300a9 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -29,7 +29,10 @@ module spectral_utilities ! grid related information real(pReal), protected, public :: wgt !< weighting factor 1/Nelems real(pReal), protected, public, dimension(3) :: scaledGeomSize !< scaled geometry size for calculation of divergence - integer :: cells1Red !< cells(1)/2+1 + integer :: & + cells1Red, & !< cells(1)/2+1 + cells2, & !< (local) cells in 2nd direction + cells2Offset !< (local) cells offset in 2nd direction !-------------------------------------------------------------------------------------------------- ! variables storing information for spectral method and FFTW @@ -260,11 +263,6 @@ subroutine spectral_utilities_init() print'(/,1x,a)', 'FFTW initialized'; flush(IO_STDOUT) -!-------------------------------------------------------------------------------------------------- -! allocation - allocate (xi1st (3,cells1Red,cells(2),cells3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for first derivatives, only half the size for first dimension - allocate (xi2nd (3,cells1Red,cells(2),cells3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for second derivatives, only half the size for first dimension - cellsFFTW = int(cells,C_INTPTR_T) N = fftw_mpi_local_size_many_transposed(3,[cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T)], & @@ -295,6 +293,15 @@ subroutine spectral_utilities_init() [int(cells1Red*2,C_INTPTR_T),cellsFFTW(2),cells3FFTW]) call c_f_pointer(scalarField,scalarField_fourier, & [int(cells1Red, C_INTPTR_T),cellsFFTW(2),cells3FFTW]) + ![int(cells1Red, C_INTPTR_T),cellsFFTW(3),cells2FFTW]) ! ToDo + + cells2Offset = 0 ! ToDo + cells2 = cells(2) ! ToDo + +!-------------------------------------------------------------------------------------------------- +! allocation + allocate (xi1st (3,cells1Red,cells2,cells3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for first derivatives, only half the size for first dimension + allocate (xi2nd (3,cells1Red,cells2,cells3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for second derivatives, only half the size for first dimension !-------------------------------------------------------------------------------------------------- ! tensor MPI fftw plans @@ -336,14 +343,16 @@ subroutine spectral_utilities_init() !-------------------------------------------------------------------------------------------------- ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around) do k = cells3Offset+1, cells3Offset+cells3 + !do k = 1, cells(3) ToDo k_s(3) = k - 1 if (k > cells(3)/2 + 1) k_s(3) = k_s(3) - cells(3) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 - do j = 1, cells(2) + do j = cells2Offset+1, cells2offset+cells2 k_s(2) = j - 1 if (j > cells(2)/2 + 1) k_s(2) = k_s(2) - cells(2) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 do i = 1, cells1Red k_s(1) = i - 1 ! symmetry, junst running from 0,1,...,N/2,N/2+1 xi2nd(1:3,i,j,k-cells3Offset) = utilities_getFreqDerivative(k_s) + !xi2nd(1:3,i,j-cells2Offset,k) = utilities_getFreqDerivative(k_s) ToDo where(mod(cells,2)==0 .and. [i,j,k] == cells/2+1 .and. & spectral_derivative_ID == DERIVATIVE_CONTINUOUS_ID) ! for even grids, set the Nyquist Freq component to 0.0 xi1st(1:3,i,j,k-cells3Offset) = cmplx(0.0_pReal,0.0_pReal,pReal) @@ -356,6 +365,7 @@ subroutine spectral_utilities_init() allocate (gamma_hat(3,3,3,3,1,1,1), source = cmplx(0.0_pReal,0.0_pReal,pReal)) else ! precalculation of gamma_hat field allocate (gamma_hat(3,3,3,3,cells1Red,cells(2),cells3), source = cmplx(0.0_pReal,0.0_pReal,pReal)) + !allocate (gamma_hat(3,3,3,3,cells1Red,cells2,cells(3)), source = cmplx(0.0_pReal,0.0_pReal,pReal)) ToDo end if call selfTest() From df1f362ed33ed54af45534ba0311c40249c89fbf Mon Sep 17 00:00:00 2001 From: "d.mentock" Date: Fri, 8 Jul 2022 18:06:41 +0200 Subject: [PATCH 84/99] it's useful for users to see standard docstrings in magic methods --- python/damask/_colormap.py | 49 +++++++++++++++++++++++++++----- python/damask/_config.py | 23 +++++++++++++-- python/damask/_crystal.py | 9 +++++- python/damask/_grid.py | 16 +++++++++-- python/damask/_orientation.py | 18 ++++++++++-- python/damask/_result.py | 14 +++++++-- python/damask/_rotation.py | 53 +++++++++++++++++++++++++++++++---- python/damask/_table.py | 30 +++++++++++++++++--- python/damask/_vtk.py | 9 +++++- 9 files changed, 194 insertions(+), 27 deletions(-) diff --git a/python/damask/_colormap.py b/python/damask/_colormap.py index 1d3ab74ec..ea3d16688 100644 --- a/python/damask/_colormap.py +++ b/python/damask/_colormap.py @@ -48,7 +48,12 @@ class Colormap(mpl.colors.ListedColormap): def __eq__(self, other: object) -> bool: - """Test equality of colormaps.""" + """ + Return self==other. + + Test equality of colormaps. + + """ if not isinstance(other, Colormap): return NotImplemented return len(self.colors) == len(other.colors) \ @@ -56,31 +61,61 @@ class Colormap(mpl.colors.ListedColormap): def __add__(self, other: 'Colormap') -> 'Colormap': - """Concatenate.""" + """ + Return self+other. + + Concatenate. + + """ return Colormap(np.vstack((self.colors,other.colors)), f'{self.name}+{other.name}') def __iadd__(self, other: 'Colormap') -> 'Colormap': - """Concatenate (in-place).""" + """ + Return self+=other. + + Concatenate (in-place). + + """ return self.__add__(other) def __mul__(self, factor: int) -> 'Colormap': - """Repeat.""" + """ + Return self*other. + + Repeat. + + """ return Colormap(np.vstack([self.colors]*factor),f'{self.name}*{factor}') def __imul__(self, factor: int) -> 'Colormap': - """Repeat (in-place).""" + """ + Return self*=other. + + Repeat (in-place). + + """ return self.__mul__(factor) def __invert__(self) -> 'Colormap': - """Reverse.""" + """ + Return ~self. + + Return reverse of self + + """ return self.reversed() def __repr__(self) -> str: - """Show as matplotlib figure.""" + """ + Return repr(self). + + Show as matplotlib figure. + + """ fig = plt.figure(self.name,figsize=(5,.5)) ax1 = fig.add_axes([0, 0, 1, 1]) ax1.set_axis_off() diff --git a/python/damask/_config.py b/python/damask/_config.py index ff889bf5d..06ac13894 100644 --- a/python/damask/_config.py +++ b/python/damask/_config.py @@ -64,7 +64,12 @@ class Config(dict): super().__init__(**kwargs) def __repr__(self) -> str: - """Show as in file.""" + """ + Return repr(self). + + Show as in file. + + """ output = StringIO() self.save(output) output.seek(0) @@ -72,7 +77,12 @@ class Config(dict): def __copy__(self: MyType) -> MyType: - """Create deep copy.""" + """ + Return deepcopy(self). + + Create deep copy. + + """ return copy.deepcopy(self) copy = __copy__ @@ -81,6 +91,8 @@ class Config(dict): def __or__(self: MyType, other) -> MyType: """ + Return self|other. + Update configuration with contents of other. Parameters @@ -105,7 +117,12 @@ class Config(dict): def __ior__(self: MyType, other) -> MyType: - """Update configuration with contents of other.""" + """ + Return self|=other. + + Update configuration with contents of other. + + """ return self.__or__(other) diff --git a/python/damask/_crystal.py b/python/damask/_crystal.py index 05a3d3384..b7b56f742 100644 --- a/python/damask/_crystal.py +++ b/python/damask/_crystal.py @@ -403,7 +403,12 @@ class Crystal(): def __repr__(self): - """Give short human-readable summary.""" + """ + Return repr(self). + + Give short human-readable summary. + + """ family = f'Crystal family: {self.family}' return family if self.lattice is None else \ util.srepr([family, @@ -415,6 +420,8 @@ class Crystal(): def __eq__(self, other: object) -> bool: """ + Return self==other. + Equal to other. Parameters diff --git a/python/damask/_grid.py b/python/damask/_grid.py index 44126519c..e5c36413f 100644 --- a/python/damask/_grid.py +++ b/python/damask/_grid.py @@ -62,7 +62,12 @@ class Grid: self.comments = [] if comments_ is None else [str(c) for c in comments_] def __repr__(self) -> str: - """Give short human-readable summary.""" + """ + Return repr(self). + + Give short human-readable summary. + + """ mat_min = np.nanmin(self.material) mat_max = np.nanmax(self.material) mat_N = self.N_materials @@ -76,7 +81,12 @@ class Grid: def __copy__(self) -> 'Grid': - """Create deep copy.""" + """ + Return deepcopy(self). + + Create deep copy. + + """ return copy.deepcopy(self) copy = __copy__ @@ -85,6 +95,8 @@ class Grid: def __eq__(self, other: object) -> bool: """ + Return self==other. + Test equality of other. Parameters diff --git a/python/damask/_orientation.py b/python/damask/_orientation.py index 4721143da..b33c4c125 100644 --- a/python/damask/_orientation.py +++ b/python/damask/_orientation.py @@ -120,14 +120,24 @@ class Orientation(Rotation,Crystal): def __repr__(self) -> str: - """Give short human-readable summary.""" + """ + Return repr(self). + + Give short human-readable summary. + + """ return util.srepr([Crystal.__repr__(self), Rotation.__repr__(self)]) def __copy__(self: MyType, rotation: Union[FloatSequence, Rotation] = None) -> MyType: - """Create deep copy.""" + """ + Return deepcopy(self). + + Create deep copy. + + """ dup = copy.deepcopy(self) if rotation is not None: dup.quaternion = Rotation(rotation).quaternion @@ -140,6 +150,8 @@ class Orientation(Rotation,Crystal): def __eq__(self, other: object) -> bool: """ + Return self==other. + Equal to other. Parameters @@ -158,6 +170,8 @@ class Orientation(Rotation,Crystal): def __ne__(self, other: object) -> bool: """ + Return self!=other. + Not equal to other. Parameters diff --git a/python/damask/_result.py b/python/damask/_result.py index b5b58bc04..1d5558c44 100644 --- a/python/damask/_result.py +++ b/python/damask/_result.py @@ -152,14 +152,24 @@ class Result: def __copy__(self) -> "Result": - """Create deep copy.""" + """ + Return deepcopy(self). + + Create deep copy. + + """ return copy.deepcopy(self) copy = __copy__ def __repr__(self) -> str: - """Give short human-readable summary.""" + """ + Return repr(self). + + Give short human-readable summary. + + """ with h5py.File(self.fname,'r') as f: header = [f'Created by {f.attrs["creator"]}', f' on {f.attrs["created"]}', diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index f93b3b012..a2fbef3fc 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -88,14 +88,24 @@ class Rotation: def __repr__(self) -> str: - """Give short human-readable summary.""" + """ + Return repr(self). + + Give short human-readable summary. + + """ return f'Quaternion{" " if self.quaternion.shape == (4,) else "s of shape "+str(self.quaternion.shape[:-1])+chr(10)}'\ + str(self.quaternion) def __copy__(self: MyType, rotation: Union[FloatSequence, 'Rotation'] = None) -> MyType: - """Create deep copy.""" + """ + Return deepcopy(self). + + Create deep copy. + + """ dup = copy.deepcopy(self) if rotation is not None: dup.quaternion = Rotation(rotation).quaternion @@ -106,7 +116,12 @@ class Rotation: def __getitem__(self, item: Union[Tuple[int], int, bool, np.bool_, np.ndarray]): - """Return slice according to item.""" + """ + Return x[y]. + + Return slice according to item. + + """ return self.copy() if self.shape == () else \ self.copy(self.quaternion[item+(slice(None),)] if isinstance(item,tuple) else self.quaternion[item]) @@ -114,6 +129,8 @@ class Rotation: def __eq__(self, other: object) -> bool: """ + Return self==other. + Equal to other. Parameters @@ -130,6 +147,8 @@ class Rotation: def __ne__(self, other: object) -> bool: """ + Return self!=other. + Not equal to other. Parameters @@ -214,12 +233,22 @@ class Rotation: def __len__(self) -> int: - """Length of leading/leftmost dimension of array.""" + """ + Return len(self). + + Length of leading/leftmost dimension of array. + + """ return 0 if self.shape == () else self.shape[0] def __invert__(self: MyType) -> MyType: - """Inverse rotation (backward rotation).""" + """ + Return ~self. + + Inverse rotation (backward rotation). + + """ dup = self.copy() dup.quaternion[...,1:] *= -1 return dup @@ -228,6 +257,8 @@ class Rotation: def __pow__(self: MyType, exp: Union[float, int]) -> MyType: """ + Return self**exp. + Perform the rotation 'exp' times. Parameters @@ -243,6 +274,8 @@ class Rotation: def __ipow__(self: MyType, exp: Union[float, int]) -> MyType: """ + Return self**=exp. + Perform the rotation 'exp' times (in-place). Parameters @@ -257,6 +290,8 @@ class Rotation: def __mul__(self: MyType, other: MyType) -> MyType: """ + Return self*other. + Compose with other. Parameters @@ -284,6 +319,8 @@ class Rotation: def __imul__(self: MyType, other: MyType) -> MyType: """ + Return self*=other. + Compose with other (in-place). Parameters @@ -298,6 +335,8 @@ class Rotation: def __truediv__(self: MyType, other: MyType) -> MyType: """ + Return self/other. + Compose with inverse of other. Parameters @@ -319,6 +358,8 @@ class Rotation: def __itruediv__(self: MyType, other: MyType) -> MyType: """ + Return self/=other. + Compose with inverse of other (in-place). Parameters @@ -333,6 +374,8 @@ class Rotation: def __matmul__(self, other: np.ndarray) -> np.ndarray: """ + Return self@other. + Rotate vector, second order tensor, or fourth order tensor. Parameters diff --git a/python/damask/_table.py b/python/damask/_table.py index f5c6f61e2..fef076649 100644 --- a/python/damask/_table.py +++ b/python/damask/_table.py @@ -37,7 +37,12 @@ class Table: def __repr__(self) -> str: - """Give short human-readable summary.""" + """ + Return repr(self). + + Give short human-readable summary. + + """ self._relabel('shapes') data_repr = self.data.__repr__() self._relabel('uniform') @@ -46,7 +51,12 @@ class Table: def __eq__(self, other: object) -> bool: - """Compare to other Table.""" + """ + Return self==other. + + Compare to other Table. + + """ return NotImplemented if not isinstance(other,Table) else \ self.shapes == other.shapes and self.data.equals(other.data) @@ -54,6 +64,8 @@ class Table: def __getitem__(self, item: Union[slice, Tuple[slice, ...]]) -> 'Table': """ + Return x[y]. + Slice the Table according to item. Parameters @@ -102,12 +114,22 @@ class Table: def __len__(self) -> int: - """Number of rows.""" + """ + Return len(self). + + Number of rows. + + """ return len(self.data) def __copy__(self) -> 'Table': - """Create deep copy.""" + """ + Return deepcopy(self). + + Create deep copy. + + """ return copy.deepcopy(self) copy = __copy__ diff --git a/python/damask/_vtk.py b/python/damask/_vtk.py index 1b7bba2fa..1e19c8bee 100644 --- a/python/damask/_vtk.py +++ b/python/damask/_vtk.py @@ -39,7 +39,12 @@ class VTK: def __repr__(self) -> str: - """Give short human-readable summary.""" + """ + Return repr(self). + + Give short human-readable summary. + + """ info = [self.vtk_data.__vtkname__] for data in ['Cell Data', 'Point Data']: @@ -54,6 +59,8 @@ class VTK: def __eq__(self, other: object) -> bool: """ + Return self==other. + Equal to other. Parameters From 3492dfcd3b507cd14ded8679f1035860f665a7be Mon Sep 17 00:00:00 2001 From: "d.mentock" Date: Fri, 8 Jul 2022 18:07:07 +0200 Subject: [PATCH 85/99] Adding consistency to docstring structure --- python/damask/_colormap.py | 4 ++-- python/damask/_crystal.py | 2 +- python/damask/_orientation.py | 4 ++-- python/damask/_rotation.py | 4 ++-- python/damask/_table.py | 4 ++-- python/damask/_vtk.py | 2 +- 6 files changed, 10 insertions(+), 10 deletions(-) diff --git a/python/damask/_colormap.py b/python/damask/_colormap.py index ea3d16688..688070529 100644 --- a/python/damask/_colormap.py +++ b/python/damask/_colormap.py @@ -51,7 +51,7 @@ class Colormap(mpl.colors.ListedColormap): """ Return self==other. - Test equality of colormaps. + Test equality of other. """ if not isinstance(other, Colormap): @@ -104,7 +104,7 @@ class Colormap(mpl.colors.ListedColormap): """ Return ~self. - Return reverse of self + Reverse. """ return self.reversed() diff --git a/python/damask/_crystal.py b/python/damask/_crystal.py index b7b56f742..fb2dc3438 100644 --- a/python/damask/_crystal.py +++ b/python/damask/_crystal.py @@ -422,7 +422,7 @@ class Crystal(): """ Return self==other. - Equal to other. + Test equality of other. Parameters ---------- diff --git a/python/damask/_orientation.py b/python/damask/_orientation.py index b33c4c125..f60772901 100644 --- a/python/damask/_orientation.py +++ b/python/damask/_orientation.py @@ -152,7 +152,7 @@ class Orientation(Rotation,Crystal): """ Return self==other. - Equal to other. + Test equality of other. Parameters ---------- @@ -172,7 +172,7 @@ class Orientation(Rotation,Crystal): """ Return self!=other. - Not equal to other. + Test inequality of other. Parameters ---------- diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index a2fbef3fc..ac93fe885 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -131,7 +131,7 @@ class Rotation: """ Return self==other. - Equal to other. + Test equality of other. Parameters ---------- @@ -149,7 +149,7 @@ class Rotation: """ Return self!=other. - Not equal to other. + Test inequality of other. Parameters ---------- diff --git a/python/damask/_table.py b/python/damask/_table.py index fef076649..94cba9b89 100644 --- a/python/damask/_table.py +++ b/python/damask/_table.py @@ -54,7 +54,7 @@ class Table: """ Return self==other. - Compare to other Table. + Test equality of other table. """ return NotImplemented if not isinstance(other,Table) else \ @@ -66,7 +66,7 @@ class Table: """ Return x[y]. - Slice the Table according to item. + Return table slice according to item. Parameters ---------- diff --git a/python/damask/_vtk.py b/python/damask/_vtk.py index 1e19c8bee..46d779023 100644 --- a/python/damask/_vtk.py +++ b/python/damask/_vtk.py @@ -61,7 +61,7 @@ class VTK: """ Return self==other. - Equal to other. + Test equality of other. Parameters ---------- From 11eb53d5ef8b8496ed82c979abb005db7bebbc96 Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 10 Jul 2022 13:14:08 +0200 Subject: [PATCH 86/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-498-gbb63048a0 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 58979f3c7..c1a8bca6c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-491-g9f4fc1527 +3.0.0-alpha6-498-gbb63048a0 From dda157aa5ab9f98effd55c9985b23a7c65a6a0e7 Mon Sep 17 00:00:00 2001 From: Daniel Otto de Mentock Date: Wed, 13 Jul 2022 14:10:13 +0200 Subject: [PATCH 87/99] accesses to fourier space tensors now need to correspond to transposed structure --- src/grid/spectral_utilities.f90 | 179 +++++++++++++++----------------- 1 file changed, 86 insertions(+), 93 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index bdde300a9..3461750e9 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -41,8 +41,8 @@ module spectral_utilities real(C_DOUBLE), public, dimension(:,:,:,:), pointer :: vectorField_real !< vector field in real space real(C_DOUBLE), public, dimension(:,:,:), pointer :: scalarField_real !< scalar field in real space complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:,:), pointer :: tensorField_fourier !< tensor field in Fourier space - complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), pointer :: vectorField_fourier !< tensor field in Fourier space - complex(C_DOUBLE_COMPLEX), dimension(:,:,:), pointer :: scalarField_fourier !< tensor field in Fourier space + complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), pointer :: vectorField_fourier !< vector field in Fourier space + complex(C_DOUBLE_COMPLEX), dimension(:,:,:), pointer :: scalarField_fourier !< scalar field in Fourier space complex(pReal), dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat !< gamma operator (field) for spectral method complex(pReal), dimension(:,:,:,:), allocatable :: xi1st !< wave vector field for first derivatives complex(pReal), dimension(:,:,:,:), allocatable :: xi2nd !< wave vector field for second derivatives @@ -273,7 +273,10 @@ subroutine spectral_utilities_init() call c_f_pointer(tensorField,tensorField_real, & [3_C_INTPTR_T,3_C_INTPTR_T,int(cells1Red*2,C_INTPTR_T),cellsFFTW(2),cells3FFTW]) call c_f_pointer(tensorField,tensorField_fourier, & - [3_C_INTPTR_T,3_C_INTPTR_T,int(cells1Red, C_INTPTR_T),cellsFFTW(2),cells3FFTW]) + [3_C_INTPTR_T,3_C_INTPTR_T,int(cells1Red, C_INTPTR_T),cellsFFTW(3),cells2FFTW]) + + cells2=int(cells2FFTW) + cells2Offset=int(cells2_offset) N = fftw_mpi_local_size_many_transposed(3,[cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T)], & vectorSize,FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD, & @@ -283,7 +286,7 @@ subroutine spectral_utilities_init() call c_f_pointer(vectorField,vectorField_real, & [3_C_INTPTR_T,int(cells1Red*2,C_INTPTR_T),cellsFFTW(2),cells3FFTW]) call c_f_pointer(vectorField,vectorField_fourier, & - [3_C_INTPTR_T,int(cells1Red, C_INTPTR_T),cellsFFTW(2),cells3FFTW]) + [3_C_INTPTR_T,int(cells1Red, C_INTPTR_T),cellsFFTW(3),cells2FFTW]) N = fftw_mpi_local_size_3d_transposed(cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T), & PETSC_COMM_WORLD,cells3FFTW,cells3_offset,cells2FFTW,cells2_offset) @@ -292,28 +295,24 @@ subroutine spectral_utilities_init() call c_f_pointer(scalarField,scalarField_real, & [int(cells1Red*2,C_INTPTR_T),cellsFFTW(2),cells3FFTW]) call c_f_pointer(scalarField,scalarField_fourier, & - [int(cells1Red, C_INTPTR_T),cellsFFTW(2),cells3FFTW]) - ![int(cells1Red, C_INTPTR_T),cellsFFTW(3),cells2FFTW]) ! ToDo - - cells2Offset = 0 ! ToDo - cells2 = cells(2) ! ToDo + [int(cells1Red, C_INTPTR_T),cellsFFTW(3),cells2FFTW]) !-------------------------------------------------------------------------------------------------- ! allocation - allocate (xi1st (3,cells1Red,cells2,cells3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for first derivatives, only half the size for first dimension - allocate (xi2nd (3,cells1Red,cells2,cells3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for second derivatives, only half the size for first dimension + allocate (xi1st (3,cells1Red,cells(3),cells2),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for first derivatives, only half the size for first dimension + allocate (xi2nd (3,cells1Red,cells(3),cells2),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for second derivatives, only half the size for first dimension !-------------------------------------------------------------------------------------------------- ! tensor MPI fftw plans planTensorForth = fftw_mpi_plan_many_dft_r2c(3,cellsFFTW(3:1:-1),tensorSize, & FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & tensorField_real,tensorField_fourier, & - PETSC_COMM_WORLD,FFTW_planner_flag) + PETSC_COMM_WORLD,FFTW_planner_flag+FFTW_MPI_TRANSPOSED_OUT) if (.not. c_associated(planTensorForth)) error stop 'FFTW error r2c tensor' planTensorBack = fftw_mpi_plan_many_dft_c2r(3,cellsFFTW(3:1:-1),tensorSize, & FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & tensorField_fourier,tensorField_real, & - PETSC_COMM_WORLD,FFTW_planner_flag) + PETSC_COMM_WORLD,FFTW_planner_flag+FFTW_MPI_TRANSPOSED_IN) if (.not. c_associated(planTensorBack)) error stop 'FFTW error c2r tensor' !-------------------------------------------------------------------------------------------------- @@ -321,51 +320,48 @@ subroutine spectral_utilities_init() planVectorForth = fftw_mpi_plan_many_dft_r2c(3,cellsFFTW(3:1:-1),vectorSize, & FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & vectorField_real,vectorField_fourier, & - PETSC_COMM_WORLD,FFTW_planner_flag) + PETSC_COMM_WORLD,FFTW_planner_flag+FFTW_MPI_TRANSPOSED_OUT) if (.not. c_associated(planVectorForth)) error stop 'FFTW error r2c vector' planVectorBack = fftw_mpi_plan_many_dft_c2r(3,cellsFFTW(3:1:-1),vectorSize, & FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK, & vectorField_fourier,vectorField_real, & - PETSC_COMM_WORLD,FFTW_planner_flag) + PETSC_COMM_WORLD,FFTW_planner_flag+FFTW_MPI_TRANSPOSED_IN) if (.not. c_associated(planVectorBack)) error stop 'FFTW error c2r vector' !-------------------------------------------------------------------------------------------------- ! scalar MPI fftw plans planScalarForth = fftw_mpi_plan_dft_r2c_3d(cellsFFTW(3),cellsFFTW(2),cellsFFTW(1), & scalarField_real,scalarField_fourier, & - PETSC_COMM_WORLD,FFTW_planner_flag) + PETSC_COMM_WORLD,FFTW_planner_flag+FFTW_MPI_TRANSPOSED_OUT) if (.not. c_associated(planScalarForth)) error stop 'FFTW error r2c scalar' planScalarBack = fftw_mpi_plan_dft_c2r_3d(cellsFFTW(3),cellsFFTW(2),cellsFFTW(1), & scalarField_fourier,scalarField_real, & - PETSC_COMM_WORLD,FFTW_planner_flag) + PETSC_COMM_WORLD,FFTW_planner_flag+FFTW_MPI_TRANSPOSED_IN) if (.not. c_associated(planScalarBack)) error stop 'FFTW error c2r scalar' !-------------------------------------------------------------------------------------------------- ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around) - do k = cells3Offset+1, cells3Offset+cells3 - !do k = 1, cells(3) ToDo + do k = 1, cells(3) k_s(3) = k - 1 if (k > cells(3)/2 + 1) k_s(3) = k_s(3) - cells(3) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 - do j = cells2Offset+1, cells2offset+cells2 + do j = cells2Offset+1, cells2Offset+cells2 k_s(2) = j - 1 if (j > cells(2)/2 + 1) k_s(2) = k_s(2) - cells(2) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 do i = 1, cells1Red k_s(1) = i - 1 ! symmetry, junst running from 0,1,...,N/2,N/2+1 - xi2nd(1:3,i,j,k-cells3Offset) = utilities_getFreqDerivative(k_s) - !xi2nd(1:3,i,j-cells2Offset,k) = utilities_getFreqDerivative(k_s) ToDo + xi2nd(1:3,i,k,j-cells2Offset) = utilities_getFreqDerivative(k_s) where(mod(cells,2)==0 .and. [i,j,k] == cells/2+1 .and. & spectral_derivative_ID == DERIVATIVE_CONTINUOUS_ID) ! for even grids, set the Nyquist Freq component to 0.0 - xi1st(1:3,i,j,k-cells3Offset) = cmplx(0.0_pReal,0.0_pReal,pReal) + xi1st(1:3,i,k,j-cells2Offset) = cmplx(0.0_pReal,0.0_pReal,pReal) elsewhere - xi1st(1:3,i,j,k-cells3Offset) = xi2nd(1:3,i,j,k-cells3Offset) + xi1st(1:3,i,k,j-cells2Offset) = xi2nd(1:3,i,k,j-cells2Offset) endwhere end do; end do; end do if (num%memory_efficient) then ! allocate just single fourth order tensor allocate (gamma_hat(3,3,3,3,1,1,1), source = cmplx(0.0_pReal,0.0_pReal,pReal)) else ! precalculation of gamma_hat field - allocate (gamma_hat(3,3,3,3,cells1Red,cells(2),cells3), source = cmplx(0.0_pReal,0.0_pReal,pReal)) - !allocate (gamma_hat(3,3,3,3,cells1Red,cells2,cells(3)), source = cmplx(0.0_pReal,0.0_pReal,pReal)) ToDo + allocate (gamma_hat(3,3,3,3,cells1Red,cells(3),cells2), source = cmplx(0.0_pReal,0.0_pReal,pReal)) end if call selfTest() @@ -394,18 +390,18 @@ subroutine utilities_updateGamma(C) if (.not. num%memory_efficient) then gamma_hat = cmplx(0.0_pReal,0.0_pReal,pReal) ! for the singular point and any non invertible A !$OMP PARALLEL DO PRIVATE(l,m,n,o,temp33_cmplx,xiDyad_cmplx,A,A_inv,err) - do k = cells3Offset+1, cells3Offset+cells3; do j = 1, cells(2); do i = 1, cells1Red + do k = 1, cells(3); do j = cells2Offset+1, cells2Offset+cells2; do i = 1, cells1Red if (any([i,j,k] /= 1)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 #ifndef __INTEL_COMPILER do concurrent(l = 1:3, m = 1:3) - xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k-cells3Offset))*xi1st(m,i,j,k-cells3Offset) + xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j-cells2Offset))*xi1st(m,i,k,j-cells2Offset) end do do concurrent(l = 1:3, m = 1:3) temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx) end do #else forall(l = 1:3, m = 1:3) & - xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k-cells3Offset))*xi1st(m,i,j,k-cells3Offset) + xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j-cells2Offset))*xi1st(m,i,k,j-cells2Offset) forall(l = 1:3, m = 1:3) & temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx) #endif @@ -416,11 +412,11 @@ subroutine utilities_updateGamma(C) temp33_cmplx = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pReal) #ifndef __INTEL_COMPILER do concurrent(l=1:3, m=1:3, n=1:3, o=1:3) - gamma_hat(l,m,n,o,i,j,k-cells3Offset) = temp33_cmplx(l,n) * xiDyad_cmplx(o,m) + gamma_hat(l,m,n,o,i,k,j-cells2Offset) = temp33_cmplx(l,n) * xiDyad_cmplx(o,m) end do #else forall(l=1:3, m=1:3, n=1:3, o=1:3) & - gamma_hat(l,m,n,o,i,j,k-cells3Offset) = temp33_cmplx(l,n) * xiDyad_cmplx(o,m) + gamma_hat(l,m,n,o,i,k,j-cells2Offset) = temp33_cmplx(l,n) * xiDyad_cmplx(o,m) #endif end if end if @@ -527,18 +523,18 @@ subroutine utilities_fourierGammaConvolution(fieldAim) ! do the actual spectral method calculation (mechanical equilibrium) memoryEfficient: if (num%memory_efficient) then !$OMP PARALLEL DO PRIVATE(l,m,n,o,temp33_cmplx,xiDyad_cmplx,A,A_inv,err,gamma_hat) - do k = 1, cells3; do j = 1, cells(2); do i = 1, cells1Red - if (any([i,j,k+cells3Offset] /= 1)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 + do k = 1, cells(3); do j = 1, cells2; do i = 1, cells1Red + if (any([i,j+cells2Offset,k] /= 1)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 #ifndef __INTEL_COMPILER do concurrent(l = 1:3, m = 1:3) - xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k))*xi1st(m,i,j,k) + xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j))*xi1st(m,i,k,j) end do do concurrent(l = 1:3, m = 1:3) temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx) end do #else forall(l = 1:3, m = 1:3) & - xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k))*xi1st(m,i,j,k) + xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j))*xi1st(m,i,k,j) forall(l = 1:3, m = 1:3) & temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx) #endif @@ -552,33 +548,33 @@ subroutine utilities_fourierGammaConvolution(fieldAim) gamma_hat(l,m,n,o,1,1,1) = temp33_cmplx(l,n)*xiDyad_cmplx(o,m) end do do concurrent(l = 1:3, m = 1:3) - temp33_cmplx(l,m) = sum(gamma_hat(l,m,1:3,1:3,1,1,1)*tensorField_fourier(1:3,1:3,i,j,k)) + temp33_cmplx(l,m) = sum(gamma_hat(l,m,1:3,1:3,1,1,1)*tensorField_fourier(1:3,1:3,i,k,j)) end do #else forall(l=1:3, m=1:3, n=1:3, o=1:3) & gamma_hat(l,m,n,o,1,1,1) = temp33_cmplx(l,n)*xiDyad_cmplx(o,m) forall(l = 1:3, m = 1:3) & - temp33_cmplx(l,m) = sum(gamma_hat(l,m,1:3,1:3,1,1,1)*tensorField_fourier(1:3,1:3,i,j,k)) + temp33_cmplx(l,m) = sum(gamma_hat(l,m,1:3,1:3,1,1,1)*tensorField_fourier(1:3,1:3,i,k,j)) #endif - tensorField_fourier(1:3,1:3,i,j,k) = temp33_cmplx + tensorField_fourier(1:3,1:3,i,k,j) = temp33_cmplx else - tensorField_fourier(1:3,1:3,i,j,k) = cmplx(0.0_pReal,0.0_pReal,pReal) + tensorField_fourier(1:3,1:3,i,k,j) = cmplx(0.0_pReal,0.0_pReal,pReal) end if end if end do; end do; end do !$OMP END PARALLEL DO else memoryEfficient !$OMP PARALLEL DO PRIVATE(l,m,temp33_cmplx) - do k = 1, cells3; do j = 1, cells(2); do i = 1,cells1Red + do k = 1, cells(3); do j = 1, cells2; do i = 1,cells1Red #ifndef __INTEL_COMPILER do concurrent(l = 1:3, m = 1:3) - temp33_cmplx(l,m) = sum(gamma_hat(l,m,1:3,1:3,i,j,k)*tensorField_fourier(1:3,1:3,i,j,k)) + temp33_cmplx(l,m) = sum(gamma_hat(l,m,1:3,1:3,i,k,j)*tensorField_fourier(1:3,1:3,i,k,j)) end do #else forall(l = 1:3, m = 1:3) & - temp33_cmplx(l,m) = sum(gamma_hat(l,m,1:3,1:3,i,j,k)*tensorField_fourier(1:3,1:3,i,j,k)) + temp33_cmplx(l,m) = sum(gamma_hat(l,m,1:3,1:3,i,k,j)*tensorField_fourier(1:3,1:3,i,k,j)) #endif - tensorField_fourier(1:3,1:3,i,j,k) = temp33_cmplx + tensorField_fourier(1:3,1:3,i,k,j) = temp33_cmplx end do; end do; end do !$OMP END PARALLEL DO end if memoryEfficient @@ -601,11 +597,11 @@ subroutine utilities_fourierGreenConvolution(D_ref, mu_ref, Delta_t) !-------------------------------------------------------------------------------------------------- ! do the actual spectral method calculation !$OMP PARALLEL DO PRIVATE(GreenOp_hat) - do k = 1, cells3; do j = 1, cells(2); do i = 1, cells1Red + do k = 1, cells(3); do j = 1, cells2; do i = 1, cells1Red GreenOp_hat = cmplx(1.0_pReal,0.0_pReal,pReal) & / (cmplx(mu_ref,0.0_pReal,pReal) + cmplx(Delta_t,0.0_pReal,pReal) & - * sum(conjg(xi1st(1:3,i,j,k))* matmul(cmplx(D_ref,0.0_pReal,pReal),xi1st(1:3,i,j,k)))) - scalarField_fourier(i,j,k) = scalarField_fourier(i,j,k)*GreenOp_hat + * sum(conjg(xi1st(1:3,i,k,j))* matmul(cmplx(D_ref,0.0_pReal,pReal),xi1st(1:3,i,k,j)))) + scalarField_fourier(i,k,j) = scalarField_fourier(i,k,j)*GreenOp_hat end do; end do; end do !$OMP END PARALLEL DO @@ -630,23 +626,23 @@ real(pReal) function utilities_divergenceRMS() !-------------------------------------------------------------------------------------------------- ! calculating RMS divergence criterion in Fourier space utilities_divergenceRMS = 0.0_pReal - do k = 1, cells3; do j = 1, cells(2) + do k = 1, cells(3); do j = 1, cells2 do i = 2, cells1Red -1 ! Has somewhere a conj. complex counterpart. Therefore count it twice. utilities_divergenceRMS = utilities_divergenceRMS & - + 2.0_pReal*(sum (real(matmul(tensorField_fourier(1:3,1:3,i,j,k), & ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2, i.e. do not take square root and square again - conjg(-xi1st(1:3,i,j,k))*rescaledGeom))**2) & ! --> sum squared L_2 norm of vector - +sum(aimag(matmul(tensorField_fourier(1:3,1:3,i,j,k),& - conjg(-xi1st(1:3,i,j,k))*rescaledGeom))**2)) + + 2.0_pReal*(sum (real(matmul(tensorField_fourier(1:3,1:3,i,k,j), & ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2, i.e. do not take square root and square again + conjg(-xi1st(1:3,i,k,j))*rescaledGeom))**2) & ! --> sum squared L_2 norm of vector + +sum(aimag(matmul(tensorField_fourier(1:3,1:3,i,k,j),& + conjg(-xi1st(1:3,i,k,j))*rescaledGeom))**2)) end do utilities_divergenceRMS = utilities_divergenceRMS & ! these two layers (DC and Nyquist) do not have a conjugate complex counterpart (if cells(1) /= 1) - + sum( real(matmul(tensorField_fourier(1:3,1:3,1 ,j,k), & - conjg(-xi1st(1:3,1,j,k))*rescaledGeom))**2) & - + sum(aimag(matmul(tensorField_fourier(1:3,1:3,1 ,j,k), & - conjg(-xi1st(1:3,1,j,k))*rescaledGeom))**2) & - + sum( real(matmul(tensorField_fourier(1:3,1:3,cells1Red,j,k), & - conjg(-xi1st(1:3,cells1Red,j,k))*rescaledGeom))**2) & - + sum(aimag(matmul(tensorField_fourier(1:3,1:3,cells1Red,j,k), & - conjg(-xi1st(1:3,cells1Red,j,k))*rescaledGeom))**2) + + sum( real(matmul(tensorField_fourier(1:3,1:3,1 ,k,j), & + conjg(-xi1st(1:3,1,k,j))*rescaledGeom))**2) & + + sum(aimag(matmul(tensorField_fourier(1:3,1:3,1 ,k,j), & + conjg(-xi1st(1:3,1,k,j))*rescaledGeom))**2) & + + sum( real(matmul(tensorField_fourier(1:3,1:3,cells1Red,k,j), & + conjg(-xi1st(1:3,cells1Red,k,j))*rescaledGeom))**2) & + + sum(aimag(matmul(tensorField_fourier(1:3,1:3,cells1Red,k,j), & + conjg(-xi1st(1:3,cells1Red,k,j))*rescaledGeom))**2) end do; end do if (cells(1) == 1) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pReal ! counted twice in case of cells(1) == 1 call MPI_Allreduce(MPI_IN_PLACE,utilities_divergenceRMS,1_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI) @@ -675,36 +671,36 @@ real(pReal) function utilities_curlRMS() ! calculating max curl criterion in Fourier space utilities_curlRMS = 0.0_pReal - do k = 1, cells3; do j = 1, cells(2); + do k = 1, cells(3); do j = 1, cells2; do i = 2, cells1Red - 1 do l = 1, 3 - curl_fourier(l,1) = (+tensorField_fourier(l,3,i,j,k)*xi1st(2,i,j,k)*rescaledGeom(2) & - -tensorField_fourier(l,2,i,j,k)*xi1st(3,i,j,k)*rescaledGeom(3)) - curl_fourier(l,2) = (+tensorField_fourier(l,1,i,j,k)*xi1st(3,i,j,k)*rescaledGeom(3) & - -tensorField_fourier(l,3,i,j,k)*xi1st(1,i,j,k)*rescaledGeom(1)) - curl_fourier(l,3) = (+tensorField_fourier(l,2,i,j,k)*xi1st(1,i,j,k)*rescaledGeom(1) & - -tensorField_fourier(l,1,i,j,k)*xi1st(2,i,j,k)*rescaledGeom(2)) + curl_fourier(l,1) = (+tensorField_fourier(l,3,i,k,j)*xi1st(2,i,k,j)*rescaledGeom(2) & + -tensorField_fourier(l,2,i,k,j)*xi1st(3,i,k,j)*rescaledGeom(3)) + curl_fourier(l,2) = (+tensorField_fourier(l,1,i,k,j)*xi1st(3,i,k,j)*rescaledGeom(3) & + -tensorField_fourier(l,3,i,k,j)*xi1st(1,i,k,j)*rescaledGeom(1)) + curl_fourier(l,3) = (+tensorField_fourier(l,2,i,k,j)*xi1st(1,i,k,j)*rescaledGeom(1) & + -tensorField_fourier(l,1,i,k,j)*xi1st(2,i,k,j)*rescaledGeom(2)) end do utilities_curlRMS = utilities_curlRMS & +2.0_pReal*sum(curl_fourier%re**2+curl_fourier%im**2) ! Has somewhere a conj. complex counterpart. Therefore count it twice. end do do l = 1, 3 - curl_fourier = (+tensorField_fourier(l,3,1,j,k)*xi1st(2,1,j,k)*rescaledGeom(2) & - -tensorField_fourier(l,2,1,j,k)*xi1st(3,1,j,k)*rescaledGeom(3)) - curl_fourier = (+tensorField_fourier(l,1,1,j,k)*xi1st(3,1,j,k)*rescaledGeom(3) & - -tensorField_fourier(l,3,1,j,k)*xi1st(1,1,j,k)*rescaledGeom(1)) - curl_fourier = (+tensorField_fourier(l,2,1,j,k)*xi1st(1,1,j,k)*rescaledGeom(1) & - -tensorField_fourier(l,1,1,j,k)*xi1st(2,1,j,k)*rescaledGeom(2)) + curl_fourier = (+tensorField_fourier(l,3,1,k,j)*xi1st(2,1,k,j)*rescaledGeom(2) & + -tensorField_fourier(l,2,1,k,j)*xi1st(3,1,k,j)*rescaledGeom(3)) + curl_fourier = (+tensorField_fourier(l,1,1,k,j)*xi1st(3,1,k,j)*rescaledGeom(3) & + -tensorField_fourier(l,3,1,k,j)*xi1st(1,1,k,j)*rescaledGeom(1)) + curl_fourier = (+tensorField_fourier(l,2,1,k,j)*xi1st(1,1,k,j)*rescaledGeom(1) & + -tensorField_fourier(l,1,1,k,j)*xi1st(2,1,k,j)*rescaledGeom(2)) end do utilities_curlRMS = utilities_curlRMS & + sum(curl_fourier%re**2 + curl_fourier%im**2) ! this layer (DC) does not have a conjugate complex counterpart (if cells(1) /= 1) do l = 1, 3 - curl_fourier = (+tensorField_fourier(l,3,cells1Red,j,k)*xi1st(2,cells1Red,j,k)*rescaledGeom(2) & - -tensorField_fourier(l,2,cells1Red,j,k)*xi1st(3,cells1Red,j,k)*rescaledGeom(3)) - curl_fourier = (+tensorField_fourier(l,1,cells1Red,j,k)*xi1st(3,cells1Red,j,k)*rescaledGeom(3) & - -tensorField_fourier(l,3,cells1Red,j,k)*xi1st(1,cells1Red,j,k)*rescaledGeom(1)) - curl_fourier = (+tensorField_fourier(l,2,cells1Red,j,k)*xi1st(1,cells1Red,j,k)*rescaledGeom(1) & - -tensorField_fourier(l,1,cells1Red,j,k)*xi1st(2,cells1Red,j,k)*rescaledGeom(2)) + curl_fourier = (+tensorField_fourier(l,3,cells1Red,k,j)*xi1st(2,cells1Red,k,j)*rescaledGeom(2) & + -tensorField_fourier(l,2,cells1Red,k,j)*xi1st(3,cells1Red,k,j)*rescaledGeom(3)) + curl_fourier = (+tensorField_fourier(l,1,cells1Red,k,j)*xi1st(3,cells1Red,k,j)*rescaledGeom(3) & + -tensorField_fourier(l,3,cells1Red,k,j)*xi1st(1,cells1Red,k,j)*rescaledGeom(1)) + curl_fourier = (+tensorField_fourier(l,2,cells1Red,k,j)*xi1st(1,cells1Red,k,j)*rescaledGeom(1) & + -tensorField_fourier(l,1,cells1Red,k,j)*xi1st(2,cells1Red,k,j)*rescaledGeom(2)) end do utilities_curlRMS = utilities_curlRMS & + sum(curl_fourier%re**2 + curl_fourier%im**2) ! this layer (Nyquist) does not have a conjugate complex counterpart (if cells(1) /= 1) @@ -796,8 +792,8 @@ subroutine utilities_fourierScalarGradient() integer :: i, j, k - do k = 1, cells3; do j = 1, cells(2); do i = 1,cells1Red - vectorField_fourier(1:3,i,j,k) = scalarField_fourier(i,j,k)*xi1st(1:3,i,j,k) ! ToDo: no -conjg? + do k = 1, cells(3); do j = 1, cells2; do i = 1,cells1Red + vectorField_fourier(1:3,i,k,j) = scalarField_fourier(i,k,j)*xi1st(1:3,i,k,j) ! ToDo: no -conjg? end do; end do; end do end subroutine utilities_fourierScalarGradient @@ -808,8 +804,7 @@ end subroutine utilities_fourierScalarGradient !-------------------------------------------------------------------------------------------------- subroutine utilities_fourierVectorDivergence() - - scalarField_fourier(1:cells1Red,1:cells(2),1:cells3) = sum(vectorField_fourier(1:3,1:cells1Red,1:cells(2),1:cells3) & + scalarField_fourier(1:cells1Red,1:cells(2),1:cells3) = sum(vectorField_fourier(1:3,1:cells1Red,1:cells(3),1:cells2) & *conjg(-xi1st),1) end subroutine utilities_fourierVectorDivergence @@ -822,10 +817,9 @@ subroutine utilities_fourierVectorGradient() integer :: i, j, k, m, n - - do k = 1, cells3; do j = 1, cells(2); do i = 1,cells1Red + do k = 1, cells(3); do j = 1, cells2; do i = 1,cells1Red do m = 1, 3; do n = 1, 3 - tensorField_fourier(m,n,i,j,k) = vectorField_fourier(m,i,j,k)*xi1st(n,i,j,k) + tensorField_fourier(m,n,i,k,j) = vectorField_fourier(m,i,k,j)*xi1st(n,i,k,j) end do; end do end do; end do; end do @@ -839,9 +833,8 @@ subroutine utilities_fourierTensorDivergence() integer :: i, j, k - - do k = 1, cells3; do j = 1, cells(2); do i = 1,cells1Red - vectorField_fourier(:,i,j,k) = matmul(tensorField_fourier(:,:,i,j,k),conjg(-xi1st(:,i,j,k))) + do k = 1, cells(3); do j = 1, cells2; do i = 1,cells1Red + vectorField_fourier(:,i,k,j) = matmul(tensorField_fourier(:,:,i,k,j),conjg(-xi1st(:,i,k,j))) end do; end do; end do end subroutine utilities_fourierTensorDivergence @@ -1082,12 +1075,12 @@ subroutine utilities_updateCoords(F) call utilities_FFTtensorForward() !$OMP PARALLEL DO - do k = 1, cells3; do j = 1, cells(2); do i = 1, cells1Red - if (any([i,j,k+cells3Offset] /= 1)) then - vectorField_fourier(1:3,i,j,k) = matmul(tensorField_fourier(1:3,1:3,i,j,k),xi2nd(1:3,i,j,k)) & - / sum(conjg(-xi2nd(1:3,i,j,k))*xi2nd(1:3,i,j,k)) * cmplx(wgt,0.0,pReal) + do k = 1, cells(3); do j = 1, cells2; do i = 1, cells1Red + if (any([i,j+cells2Offset,k] /= 1)) then + vectorField_fourier(1:3,i,k,j) = matmul(tensorField_fourier(1:3,1:3,i,k,j),xi2nd(1:3,i,k,j)) & + / sum(conjg(-xi2nd(1:3,i,k,j))*xi2nd(1:3,i,k,j)) * cmplx(wgt,0.0,pReal) else - vectorField_fourier(1:3,i,j,k) = cmplx(0.0,0.0,pReal) + vectorField_fourier(1:3,i,k,j) = cmplx(0.0,0.0,pReal) end if end do; end do; end do !$OMP END PARALLEL DO From b1257d6b54f0f3d7e1e039c8cfe6cf68a84bd9a3 Mon Sep 17 00:00:00 2001 From: Daniel Otto de Mentock Date: Tue, 19 Jul 2022 14:47:05 +0200 Subject: [PATCH 88/99] correcting wrong access to scalarfield_fourier --- src/grid/spectral_utilities.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 3461750e9..37421969a 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -804,7 +804,7 @@ end subroutine utilities_fourierScalarGradient !-------------------------------------------------------------------------------------------------- subroutine utilities_fourierVectorDivergence() - scalarField_fourier(1:cells1Red,1:cells(2),1:cells3) = sum(vectorField_fourier(1:3,1:cells1Red,1:cells(3),1:cells2) & + scalarField_fourier(1:cells1Red,1:cells(3),1:cells2) = sum(vectorField_fourier(1:3,1:cells1Red,1:cells(3),1:cells2) & *conjg(-xi1st),1) end subroutine utilities_fourierVectorDivergence From 27a8610d92b36d301b8079eb43413027bb6ac52a Mon Sep 17 00:00:00 2001 From: Daniel Otto de Mentock Date: Fri, 22 Jul 2022 14:58:30 +0200 Subject: [PATCH 89/99] loops over tensors in fourier space need to correspond to transposed structure --- src/grid/spectral_utilities.f90 | 34 ++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 37421969a..04434fc42 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -341,12 +341,12 @@ subroutine spectral_utilities_init() !-------------------------------------------------------------------------------------------------- ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around) - do k = 1, cells(3) - k_s(3) = k - 1 - if (k > cells(3)/2 + 1) k_s(3) = k_s(3) - cells(3) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 - do j = cells2Offset+1, cells2Offset+cells2 - k_s(2) = j - 1 - if (j > cells(2)/2 + 1) k_s(2) = k_s(2) - cells(2) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 + do j = cells2Offset+1, cells2Offset+cells2 + k_s(2) = j - 1 + if (j > cells(2)/2 + 1) k_s(2) = k_s(2) - cells(2) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 + do k = 1, cells(3) + k_s(3) = k - 1 + if (k > cells(3)/2 + 1) k_s(3) = k_s(3) - cells(3) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 do i = 1, cells1Red k_s(1) = i - 1 ! symmetry, junst running from 0,1,...,N/2,N/2+1 xi2nd(1:3,i,k,j-cells2Offset) = utilities_getFreqDerivative(k_s) @@ -390,7 +390,7 @@ subroutine utilities_updateGamma(C) if (.not. num%memory_efficient) then gamma_hat = cmplx(0.0_pReal,0.0_pReal,pReal) ! for the singular point and any non invertible A !$OMP PARALLEL DO PRIVATE(l,m,n,o,temp33_cmplx,xiDyad_cmplx,A,A_inv,err) - do k = 1, cells(3); do j = cells2Offset+1, cells2Offset+cells2; do i = 1, cells1Red + do j = cells2Offset+1, cells2Offset+cells2; do k = 1, cells(3); do i = 1, cells1Red if (any([i,j,k] /= 1)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 #ifndef __INTEL_COMPILER do concurrent(l = 1:3, m = 1:3) @@ -523,7 +523,7 @@ subroutine utilities_fourierGammaConvolution(fieldAim) ! do the actual spectral method calculation (mechanical equilibrium) memoryEfficient: if (num%memory_efficient) then !$OMP PARALLEL DO PRIVATE(l,m,n,o,temp33_cmplx,xiDyad_cmplx,A,A_inv,err,gamma_hat) - do k = 1, cells(3); do j = 1, cells2; do i = 1, cells1Red + do j = 1, cells2; do k = 1, cells(3); do i = 1, cells1Red if (any([i,j+cells2Offset,k] /= 1)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 #ifndef __INTEL_COMPILER do concurrent(l = 1:3, m = 1:3) @@ -565,7 +565,7 @@ subroutine utilities_fourierGammaConvolution(fieldAim) !$OMP END PARALLEL DO else memoryEfficient !$OMP PARALLEL DO PRIVATE(l,m,temp33_cmplx) - do k = 1, cells(3); do j = 1, cells2; do i = 1,cells1Red + do j = 1, cells2; do k = 1, cells(3); do i = 1,cells1Red #ifndef __INTEL_COMPILER do concurrent(l = 1:3, m = 1:3) temp33_cmplx(l,m) = sum(gamma_hat(l,m,1:3,1:3,i,k,j)*tensorField_fourier(1:3,1:3,i,k,j)) @@ -597,7 +597,7 @@ subroutine utilities_fourierGreenConvolution(D_ref, mu_ref, Delta_t) !-------------------------------------------------------------------------------------------------- ! do the actual spectral method calculation !$OMP PARALLEL DO PRIVATE(GreenOp_hat) - do k = 1, cells(3); do j = 1, cells2; do i = 1, cells1Red + do j = 1, cells2; do k = 1, cells(3); do i = 1, cells1Red GreenOp_hat = cmplx(1.0_pReal,0.0_pReal,pReal) & / (cmplx(mu_ref,0.0_pReal,pReal) + cmplx(Delta_t,0.0_pReal,pReal) & * sum(conjg(xi1st(1:3,i,k,j))* matmul(cmplx(D_ref,0.0_pReal,pReal),xi1st(1:3,i,k,j)))) @@ -626,7 +626,7 @@ real(pReal) function utilities_divergenceRMS() !-------------------------------------------------------------------------------------------------- ! calculating RMS divergence criterion in Fourier space utilities_divergenceRMS = 0.0_pReal - do k = 1, cells(3); do j = 1, cells2 + do j = 1, cells2; do k = 1, cells(3) do i = 2, cells1Red -1 ! Has somewhere a conj. complex counterpart. Therefore count it twice. utilities_divergenceRMS = utilities_divergenceRMS & + 2.0_pReal*(sum (real(matmul(tensorField_fourier(1:3,1:3,i,k,j), & ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2, i.e. do not take square root and square again @@ -671,7 +671,7 @@ real(pReal) function utilities_curlRMS() ! calculating max curl criterion in Fourier space utilities_curlRMS = 0.0_pReal - do k = 1, cells(3); do j = 1, cells2; + do j = 1, cells2; do k = 1, cells(3); do i = 2, cells1Red - 1 do l = 1, 3 curl_fourier(l,1) = (+tensorField_fourier(l,3,i,k,j)*xi1st(2,i,k,j)*rescaledGeom(2) & @@ -792,7 +792,7 @@ subroutine utilities_fourierScalarGradient() integer :: i, j, k - do k = 1, cells(3); do j = 1, cells2; do i = 1,cells1Red + do j = 1, cells2; do k = 1, cells(3); do i = 1,cells1Red vectorField_fourier(1:3,i,k,j) = scalarField_fourier(i,k,j)*xi1st(1:3,i,k,j) ! ToDo: no -conjg? end do; end do; end do @@ -817,7 +817,7 @@ subroutine utilities_fourierVectorGradient() integer :: i, j, k, m, n - do k = 1, cells(3); do j = 1, cells2; do i = 1,cells1Red + do j = 1, cells2; do k = 1, cells(3); do i = 1,cells1Red do m = 1, 3; do n = 1, 3 tensorField_fourier(m,n,i,k,j) = vectorField_fourier(m,i,k,j)*xi1st(n,i,k,j) end do; end do @@ -833,7 +833,7 @@ subroutine utilities_fourierTensorDivergence() integer :: i, j, k - do k = 1, cells(3); do j = 1, cells2; do i = 1,cells1Red + do j = 1, cells2; do k = 1, cells(3); do i = 1,cells1Red vectorField_fourier(:,i,k,j) = matmul(tensorField_fourier(:,:,i,k,j),conjg(-xi1st(:,i,k,j))) end do; end do; end do @@ -1075,7 +1075,7 @@ subroutine utilities_updateCoords(F) call utilities_FFTtensorForward() !$OMP PARALLEL DO - do k = 1, cells(3); do j = 1, cells2; do i = 1, cells1Red + do j = 1, cells2; do k = 1, cells(3); do i = 1, cells1Red if (any([i,j+cells2Offset,k] /= 1)) then vectorField_fourier(1:3,i,k,j) = matmul(tensorField_fourier(1:3,1:3,i,k,j),xi2nd(1:3,i,k,j)) & / sum(conjg(-xi2nd(1:3,i,k,j))*xi2nd(1:3,i,k,j)) * cmplx(wgt,0.0,pReal) @@ -1123,7 +1123,7 @@ subroutine utilities_updateCoords(F) !-------------------------------------------------------------------------------------------------- ! calculate nodal displacements nodeCoords = 0.0_pReal - do k = 0,cells3; do j = 0,cells(2); do i = 0,cells(1) + do j = 0,cells(2); do k = 0,cells3; do i = 0,cells(1) nodeCoords(1:3,i+1,j+1,k+1) = matmul(Favg,step*(real([i,j,k+cells3Offset],pReal))) averageFluct: do n = 1,8 me = [i+neighbor(1,n),j+neighbor(2,n),k+neighbor(3,n)] From 44d9663ff008630ae84e8d1e3a6bd8ef6a800cdc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jul 2022 21:55:17 +0200 Subject: [PATCH 90/99] standard name --- python/damask/util.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/python/damask/util.py b/python/damask/util.py index f6d67fb37..610d3f88a 100644 --- a/python/damask/util.py +++ b/python/damask/util.py @@ -468,8 +468,8 @@ def shapeshifter(fro: _Tuple[int, ...], new_dims : tuple Dimensions for reshape. - Example - ------- + Examples + -------- >>> import numpy as np >>> from damask import util >>> a = np.ones((3,4,2)) From 5f4808b0f367a7d24b3cc8d6de16fd61a6726cb3 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 27 Jul 2022 03:13:56 +0200 Subject: [PATCH 91/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-500-g44d9663ff --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index c1a8bca6c..4ff376340 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-498-gbb63048a0 +3.0.0-alpha6-500-g44d9663ff From fb38340184d6abae8257e35178c235431aff7869 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 27 Jul 2022 12:56:37 +0200 Subject: [PATCH 92/99] glitch in example --- python/damask/_result.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/damask/_result.py b/python/damask/_result.py index b5b58bc04..42b460835 100644 --- a/python/damask/_result.py +++ b/python/damask/_result.py @@ -83,7 +83,7 @@ class Result: >>> import damask >>> r = damask.Result('my_file.hdf5') - >>> r.add_Cauchy() + >>> r.add_stress_Cauchy() >>> r.add_equivalent_Mises('sigma') >>> r.export_VTK() >>> r_last = r.view(increments=-1) From 1819ad05e0ab3732c821492c93166e922d820853 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 27 Jul 2022 19:20:26 +0200 Subject: [PATCH 93/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-503-ge04587490 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 4ff376340..b45629986 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-500-g44d9663ff +3.0.0-alpha6-503-ge04587490 From 4dc3e4a9445c1206478e36f22e47f1dc79cdbf4b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 28 Jul 2022 23:28:35 +0200 Subject: [PATCH 94/99] test for upcoming transpose MPI-FFT --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index a561f30a9..cdca8ab0c 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit a561f30a96c5b90e220b905a24c9d54acd479497 +Subproject commit cdca8ab0c14b637c18279e0ea236caa148d15e5e From 237bda5ccf6e4bf033792040d01fe0b22daf12c9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 29 Jul 2022 07:29:20 +0200 Subject: [PATCH 95/99] ensuring matching domain decomposition for all transforms --- src/grid/spectral_utilities.f90 | 36 +++++++++++++++++---------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index ead23f0c0..f5e1642cc 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -32,8 +32,8 @@ module spectral_utilities !-------------------------------------------------------------------------------------------------- ! grid related information - real(pReal), protected, public :: wgt !< weighting factor 1/Nelems - real(pReal), protected, public, dimension(3) :: scaledGeomSize !< scaled geometry size for calculation of divergence + real(pReal), protected, public :: wgt !< weighting factor 1/Nelems + real(pReal), protected, public, dimension(3) :: scaledGeomSize !< scaled geometry size for calculation of divergence integer :: & cells1Red, & !< cells(1)/2+1 cells2, & !< (local) cells in 2nd direction @@ -42,16 +42,16 @@ module spectral_utilities !-------------------------------------------------------------------------------------------------- ! variables storing information for spectral method and FFTW - real(C_DOUBLE), public, dimension(:,:,:,:,:), pointer :: tensorField_real !< tensor field in real space - real(C_DOUBLE), public, dimension(:,:,:,:), pointer :: vectorField_real !< vector field in real space - real(C_DOUBLE), public, dimension(:,:,:), pointer :: scalarField_real !< scalar field in real space - complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:,:), pointer :: tensorField_fourier !< tensor field in Fourier space - complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), pointer :: vectorField_fourier !< vector field in Fourier space - complex(C_DOUBLE_COMPLEX), dimension(:,:,:), pointer :: scalarField_fourier !< scalar field in Fourier space - complex(pReal), dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat !< gamma operator (field) for spectral method - complex(pReal), dimension(:,:,:,:), allocatable :: xi1st !< wave vector field for first derivatives - complex(pReal), dimension(:,:,:,:), allocatable :: xi2nd !< wave vector field for second derivatives - real(pReal), dimension(3,3,3,3) :: C_ref !< mechanic reference stiffness + real(C_DOUBLE), public, dimension(:,:,:,:,:), pointer :: tensorField_real !< tensor field in real space + real(C_DOUBLE), public, dimension(:,:,:,:), pointer :: vectorField_real !< vector field in real space + real(C_DOUBLE), public, dimension(:,:,:), pointer :: scalarField_real !< scalar field in real space + complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:,:), pointer :: tensorField_fourier !< tensor field in Fourier space + complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), pointer :: vectorField_fourier !< vector field in Fourier space + complex(C_DOUBLE_COMPLEX), dimension(:,:,:), pointer :: scalarField_fourier !< scalar field in Fourier space + complex(pReal), dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat !< gamma operator (field) for spectral method + complex(pReal), dimension(:,:,:,:), allocatable :: xi1st !< wave vector field for first derivatives + complex(pReal), dimension(:,:,:,:), allocatable :: xi2nd !< wave vector field for second derivatives + real(pReal), dimension(3,3,3,3) :: C_ref !< mechanic reference stiffness !-------------------------------------------------------------------------------------------------- @@ -273,20 +273,21 @@ subroutine spectral_utilities_init() N = fftw_mpi_local_size_many_transposed(3,[cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T)], & tensorSize,FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD, & cells3FFTW,cells3_offset,cells2FFTW,cells2_offset) - if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (tensor)' + cells2 = int(cells2FFTW) + cells2Offset = int(cells2_offset) + if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (tensor, real space)' tensorField = fftw_alloc_complex(N) call c_f_pointer(tensorField,tensorField_real, & [3_C_INTPTR_T,3_C_INTPTR_T,int(cells1Red*2,C_INTPTR_T),cellsFFTW(2),cells3FFTW]) call c_f_pointer(tensorField,tensorField_fourier, & [3_C_INTPTR_T,3_C_INTPTR_T,int(cells1Red, C_INTPTR_T),cellsFFTW(3),cells2FFTW]) - cells2=int(cells2FFTW) - cells2Offset=int(cells2_offset) N = fftw_mpi_local_size_many_transposed(3,[cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T)], & vectorSize,FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK,PETSC_COMM_WORLD, & cells3FFTW,cells3_offset,cells2FFTW,cells2_offset) - if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (vector)' + if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (vector, real space)' + if (int(cells2FFTW) /= cells2) error stop 'domain decomposition mismatch (vector, Fourier space)' vectorField = fftw_alloc_complex(N) call c_f_pointer(vectorField,vectorField_real, & [3_C_INTPTR_T,int(cells1Red*2,C_INTPTR_T),cellsFFTW(2),cells3FFTW]) @@ -295,7 +296,8 @@ subroutine spectral_utilities_init() N = fftw_mpi_local_size_3d_transposed(cellsFFTW(3),cellsFFTW(2),int(cells1Red,C_INTPTR_T), & PETSC_COMM_WORLD,cells3FFTW,cells3_offset,cells2FFTW,cells2_offset) - if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (scalar)' + if (int(cells3FFTW) /= cells3) error stop 'domain decomposition mismatch (scalar, real space)' + if (int(cells2FFTW) /= cells2) error stop 'domain decomposition mismatch (scalar, Fourier space)' scalarField = fftw_alloc_complex(N) call c_f_pointer(scalarField,scalarField_real, & [int(cells1Red*2,C_INTPTR_T),cellsFFTW(2),cells3FFTW]) From dcae40123f85c478ef84b4f3b7f75210cf5148e0 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 1 Aug 2022 23:55:34 +0200 Subject: [PATCH 96/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-518-gddbc854b0 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index b45629986..826135017 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-503-ge04587490 +3.0.0-alpha6-518-gddbc854b0 From 009320c9fcfc2beb2ed32dd77b5a064f86104bae Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Tue, 9 Aug 2022 09:29:22 -0400 Subject: [PATCH 97/99] polishing of doc-strings --- python/damask/_rotation.py | 6 +++--- python/damask/_table.py | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index ac93fe885..229e1324e 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -117,7 +117,7 @@ class Rotation: def __getitem__(self, item: Union[Tuple[int], int, bool, np.bool_, np.ndarray]): """ - Return x[y]. + Return self[item]. Return slice according to item. @@ -376,7 +376,7 @@ class Rotation: """ Return self@other. - Rotate vector, second order tensor, or fourth order tensor. + Rotate vector, second-order tensor, or fourth-order tensor. Parameters ---------- @@ -408,7 +408,7 @@ class Rotation: R = self.as_matrix() return np.einsum('...im,...jn,...ko,...lp,...mnop',R,R,R,R,other) else: - raise ValueError('can only rotate vectors, 2nd order tensors, and 4th order tensors') + raise ValueError('can only rotate vectors, second-order tensors, and fourth-order tensors') elif isinstance(other, Rotation): raise TypeError('use "R1*R2", i.e. multiplication, to compose rotations "R1" and "R2"') else: diff --git a/python/damask/_table.py b/python/damask/_table.py index 94cba9b89..b42c18703 100644 --- a/python/damask/_table.py +++ b/python/damask/_table.py @@ -54,7 +54,7 @@ class Table: """ Return self==other. - Test equality of other table. + Test equality of other. """ return NotImplemented if not isinstance(other,Table) else \ @@ -64,9 +64,9 @@ class Table: def __getitem__(self, item: Union[slice, Tuple[slice, ...]]) -> 'Table': """ - Return x[y]. + Return self[item]. - Return table slice according to item. + Return slice according to item. Parameters ---------- From e13196b7702e531094b2a3b9e47f07e67aec8598 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 11 Aug 2022 06:42:24 +0200 Subject: [PATCH 98/99] [skip ci] updated version information after successful test of v3.0.0-alpha6-523-g66f129273 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 826135017..36fddc4d8 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha6-518-gddbc854b0 +3.0.0-alpha6-523-g66f129273 From 400323a9aa4a68b0e28786437e35d13416397097 Mon Sep 17 00:00:00 2001 From: Daniel Otto de Mentock Date: Fri, 12 Aug 2022 18:45:40 +0000 Subject: [PATCH 99/99] Modified shapeshifter function --- python/damask/util.py | 43 ++++++++++++++++++------------------------- 1 file changed, 18 insertions(+), 25 deletions(-) diff --git a/python/damask/util.py b/python/damask/util.py index 610d3f88a..ec42dede0 100644 --- a/python/damask/util.py +++ b/python/damask/util.py @@ -478,33 +478,26 @@ def shapeshifter(fro: _Tuple[int, ...], >>> (a * np.broadcast_to(b_extended,a.shape)).shape (3,4,2) - """ - if len(fro) == 0 and len(to) == 0: return () - - beg = dict(left ='(^.*\\b)', - right='(^.*?\\b)') - sep = dict(left ='(.*\\b)', - right='(.*?\\b)') - end = dict(left ='(.*?$)', - right='(.*$)') - fro = (1,) if len(fro) == 0 else fro - to = (1,) if len(to) == 0 else to - try: - match = _re.match(beg[mode] - +f',{sep[mode]}'.join(map(lambda x: f'{x}' - if x>1 or (keep_ones and len(fro)>1) else - '\\d+',fro)) - +f',{end[mode]}',','.join(map(str,to))+',') - assert match - grp = match.groups() - except AssertionError: - raise ValueError(f'shapes cannot be shifted {fro} --> {to}') - fill: _Any = () - for g,d in zip(grp,fro+(None,)): - fill += (1,)*g.count(',')+(d,) - return fill[:-1] + if len(fro) == 0 and len(to) == 0: return tuple() + _fro = [1] if len(fro) == 0 else list(fro)[::-1 if mode=='left' else 1] + _to = [1] if len(to) == 0 else list(to) [::-1 if mode=='left' else 1] + final_shape: _List[int] = [] + index = 0 + for i,item in enumerate(_to): + if item==_fro[index]: + final_shape.append(item) + index+=1 + else: + final_shape.append(1) + if _fro[index]==1 and not keep_ones: + index+=1 + if index==len(_fro): + final_shape = final_shape+[1]*(len(_to)-i-1) + break + if index!=len(_fro): raise ValueError(f'shapes cannot be shifted {fro} --> {to}') + return tuple(final_shape[::-1] if mode=='left' else final_shape) def shapeblender(a: _Tuple[int, ...], b: _Tuple[int, ...]) -> _Tuple[int, ...]: