use default string length
This commit is contained in:
parent
1be37de993
commit
9c7f6811a2
|
@ -731,7 +731,7 @@ subroutine crystallite_results
|
||||||
integer :: p,o
|
integer :: p,o
|
||||||
real(pReal), allocatable, dimension(:,:,:) :: selected_tensors
|
real(pReal), allocatable, dimension(:,:,:) :: selected_tensors
|
||||||
type(rotation), allocatable, dimension(:) :: selected_rotations
|
type(rotation), allocatable, dimension(:) :: selected_rotations
|
||||||
character(len=256) :: group,lattice_label
|
character(len=pStringLen) :: group,lattice_label
|
||||||
|
|
||||||
do p=1,size(config_name_phase)
|
do p=1,size(config_name_phase)
|
||||||
group = trim('current/constituent')//'/'//trim(config_name_phase(p))//'/generic'
|
group = trim('current/constituent')//'/'//trim(config_name_phase(p))//'/generic'
|
||||||
|
|
|
@ -68,10 +68,10 @@ program DAMASK_spectral
|
||||||
statUnit = 0, & !< file unit for statistics output
|
statUnit = 0, & !< file unit for statistics output
|
||||||
stagIter, &
|
stagIter, &
|
||||||
nActiveFields = 0
|
nActiveFields = 0
|
||||||
character(len=6) :: loadcase_string
|
|
||||||
character(len=pStringLen), dimension(:), allocatable :: fileContent
|
character(len=pStringLen), dimension(:), allocatable :: fileContent
|
||||||
character(len=1024) :: &
|
character(len=pStringLen) :: &
|
||||||
incInfo
|
incInfo, &
|
||||||
|
loadcase_string
|
||||||
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
|
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
|
||||||
type(tLoadCase) :: newLoadCase
|
type(tLoadCase) :: newLoadCase
|
||||||
type(tSolutionState), allocatable, dimension(:) :: solres
|
type(tSolutionState), allocatable, dimension(:) :: solres
|
||||||
|
@ -242,7 +242,7 @@ program DAMASK_spectral
|
||||||
newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1) ! by default, guess from previous load case
|
newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1) ! by default, guess from previous load case
|
||||||
|
|
||||||
reportAndCheck: if (worldrank == 0) then
|
reportAndCheck: if (worldrank == 0) then
|
||||||
write (loadcase_string, '(i6)' ) currentLoadCase
|
write (loadcase_string, '(i0)' ) currentLoadCase
|
||||||
write(6,'(/,1x,a,i0)') 'load case: ', currentLoadCase
|
write(6,'(/,1x,a,i0)') 'load case: ', currentLoadCase
|
||||||
if (.not. newLoadCase%followFormerTrajectory) write(6,'(2x,a)') 'drop guessing along trajectory'
|
if (.not. newLoadCase%followFormerTrajectory) write(6,'(2x,a)') 'drop guessing along trajectory'
|
||||||
if (newLoadCase%deformation%myType == 'l') then
|
if (newLoadCase%deformation%myType == 'l') then
|
||||||
|
|
|
@ -59,7 +59,7 @@ subroutine grid_damage_spectral_init
|
||||||
DM :: damage_grid
|
DM :: damage_grid
|
||||||
Vec :: uBound, lBound
|
Vec :: uBound, lBound
|
||||||
PetscErrorCode :: ierr
|
PetscErrorCode :: ierr
|
||||||
character(len=100) :: snes_type
|
character(len=pStringLen) :: snes_type
|
||||||
|
|
||||||
write(6,'(/,a)') ' <<<+- grid_spectral_damage init -+>>>'
|
write(6,'(/,a)') ' <<<+- grid_spectral_damage init -+>>>'
|
||||||
|
|
||||||
|
|
|
@ -120,7 +120,6 @@ module spectral_utilities
|
||||||
character(len=pStringLen) :: &
|
character(len=pStringLen) :: &
|
||||||
spectral_derivative, & !< approximation used for derivatives in Fourier space
|
spectral_derivative, & !< approximation used for derivatives in Fourier space
|
||||||
FFTW_plan_mode, & !< FFTW plan mode, see www.fftw.org
|
FFTW_plan_mode, & !< FFTW plan mode, see www.fftw.org
|
||||||
PETSc_defaultOptions, &
|
|
||||||
PETSc_options
|
PETSc_options
|
||||||
end type tNumerics
|
end type tNumerics
|
||||||
|
|
||||||
|
@ -220,8 +219,6 @@ subroutine utilities_init
|
||||||
CHKERRQ(ierr)
|
CHKERRQ(ierr)
|
||||||
if(debugPETSc) call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr)
|
if(debugPETSc) call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr)
|
||||||
CHKERRQ(ierr)
|
CHKERRQ(ierr)
|
||||||
call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_defaultOptions),ierr)
|
|
||||||
CHKERRQ(ierr)
|
|
||||||
call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr)
|
call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr)
|
||||||
CHKERRQ(ierr)
|
CHKERRQ(ierr)
|
||||||
|
|
||||||
|
|
|
@ -58,9 +58,9 @@ program DAMASK_FEM
|
||||||
statUnit = 0, & !< file unit for statistics output
|
statUnit = 0, & !< file unit for statistics output
|
||||||
stagIter, &
|
stagIter, &
|
||||||
component
|
component
|
||||||
character(len=6) :: loadcase_string
|
character(len=pStringLen) :: &
|
||||||
character(len=1024) :: &
|
incInfo, &
|
||||||
incInfo
|
loadcase_string
|
||||||
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
|
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
|
||||||
type(tSolutionState), allocatable, dimension(:) :: solres
|
type(tSolutionState), allocatable, dimension(:) :: solres
|
||||||
PetscInt :: faceSet, currentFaceSet
|
PetscInt :: faceSet, currentFaceSet
|
||||||
|
@ -197,33 +197,33 @@ program DAMASK_FEM
|
||||||
loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase
|
loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase
|
||||||
errorID = 0
|
errorID = 0
|
||||||
checkLoadcases: do currentLoadCase = 1, size(loadCases)
|
checkLoadcases: do currentLoadCase = 1, size(loadCases)
|
||||||
write (loadcase_string, '(i6)' ) currentLoadCase
|
write (loadcase_string, '(i0)' ) currentLoadCase
|
||||||
write(6,'(1x,a,i6)') 'load case: ', currentLoadCase
|
write(6,'(1x,a,i6)') 'load case: ', currentLoadCase
|
||||||
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
|
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
|
||||||
write(6,'(2x,a)') 'drop guessing along trajectory'
|
write(6,'(2x,a)') 'drop guessing along trajectory'
|
||||||
do field = 1, nActiveFields
|
do field = 1, nActiveFields
|
||||||
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
|
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
|
||||||
case(FIELD_MECH_ID)
|
case(FIELD_MECH_ID)
|
||||||
write(6,'(2x,a)') 'Field '//trim(FIELD_MECH_label)
|
write(6,'(2x,a)') 'Field '//trim(FIELD_MECH_label)
|
||||||
|
|
||||||
end select
|
end select
|
||||||
do faceSet = 1, mesh_Nboundaries
|
do faceSet = 1, mesh_Nboundaries
|
||||||
do component = 1, loadCases(currentLoadCase)%fieldBC(field)%nComponents
|
do component = 1, loadCases(currentLoadCase)%fieldBC(field)%nComponents
|
||||||
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) &
|
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) &
|
||||||
write(6,'(4x,a,i2,a,i2,a,f12.7)') 'Face ', mesh_boundaries(faceSet), &
|
write(6,'(4x,a,i2,a,i2,a,f12.7)') 'Face ', mesh_boundaries(faceSet), &
|
||||||
' Component ', component, &
|
' Component ', component, &
|
||||||
' Value ', loadCases(currentLoadCase)%fieldBC(field)% &
|
' Value ', loadCases(currentLoadCase)%fieldBC(field)% &
|
||||||
componentBC(component)%Value(faceSet)
|
componentBC(component)%Value(faceSet)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
|
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
|
||||||
if (loadCases(currentLoadCase)%incs < 1) errorID = 835 ! non-positive incs count
|
if (loadCases(currentLoadCase)%incs < 1) errorID = 835 ! non-positive incs count
|
||||||
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
|
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
|
||||||
if (loadCases(currentLoadCase)%outputfrequency < 1) errorID = 836 ! non-positive result frequency
|
if (loadCases(currentLoadCase)%outputfrequency < 1) errorID = 836 ! non-positive result frequency
|
||||||
write(6,'(2x,a,i5)') 'output frequency: ', &
|
write(6,'(2x,a,i5)') 'output frequency: ', &
|
||||||
loadCases(currentLoadCase)%outputfrequency
|
loadCases(currentLoadCase)%outputfrequency
|
||||||
if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
|
if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
|
||||||
enddo checkLoadcases
|
enddo checkLoadcases
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
|
|
@ -48,7 +48,7 @@ module FEM_mech
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
! stress, stiffness and compliance average etc.
|
! stress, stiffness and compliance average etc.
|
||||||
character(len=1024) :: incInfo
|
character(len=pStringLen) :: incInfo
|
||||||
real(pReal), dimension(3,3) :: &
|
real(pReal), dimension(3,3) :: &
|
||||||
P_av = 0.0_pReal
|
P_av = 0.0_pReal
|
||||||
logical :: ForwardData
|
logical :: ForwardData
|
||||||
|
|
|
@ -68,17 +68,17 @@ contains
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
subroutine mesh_init
|
subroutine mesh_init
|
||||||
|
|
||||||
integer, dimension(1), parameter:: FE_geomtype = [1] !< geometry type of particular element type
|
integer, dimension(1), parameter:: FE_geomtype = [1] !< geometry type of particular element type
|
||||||
integer, dimension(1) :: FE_Nips !< number of IPs in a specific type of element
|
integer, dimension(1) :: FE_Nips !< number of IPs in a specific type of element
|
||||||
|
|
||||||
integer, parameter :: FILEUNIT = 222
|
integer, parameter :: FILEUNIT = 222
|
||||||
integer :: j
|
integer :: j
|
||||||
integer, allocatable, dimension(:) :: chunkPos
|
integer, allocatable, dimension(:) :: chunkPos
|
||||||
integer :: dimPlex, &
|
integer :: dimPlex, &
|
||||||
mesh_Nnodes !< total number of nodes in mesh
|
mesh_Nnodes !< total number of nodes in mesh
|
||||||
integer, parameter :: &
|
integer, parameter :: &
|
||||||
mesh_ElemType=1 !< Element type of the mesh (only support homogeneous meshes)
|
mesh_ElemType=1 !< Element type of the mesh (only support homogeneous meshes)
|
||||||
character(len=512) :: &
|
character(len=pStringLen) :: &
|
||||||
line
|
line
|
||||||
logical :: flag
|
logical :: flag
|
||||||
PetscSF :: sf
|
PetscSF :: sf
|
||||||
|
@ -129,7 +129,7 @@ subroutine mesh_init
|
||||||
flag = .false.
|
flag = .false.
|
||||||
call IO_open_file(FILEUNIT,trim(geometryFile))
|
call IO_open_file(FILEUNIT,trim(geometryFile))
|
||||||
do
|
do
|
||||||
read(FILEUNIT,'(A)') line
|
read(FILEUNIT,'(a)') line
|
||||||
if (trim(line) == IO_EOF) exit ! skip empty lines
|
if (trim(line) == IO_EOF) exit ! skip empty lines
|
||||||
if (trim(line) == '$Elements') then
|
if (trim(line) == '$Elements') then
|
||||||
read(FILEUNIT,'(A)') line ! number of elements (ignore)
|
read(FILEUNIT,'(A)') line ! number of elements (ignore)
|
||||||
|
|
|
@ -171,7 +171,7 @@ subroutine inputRead(elem,node0_elem,connectivity_elem,microstructureAt,homogeni
|
||||||
|
|
||||||
type(tElement), intent(out) :: elem
|
type(tElement), intent(out) :: elem
|
||||||
real(pReal), dimension(:,:), allocatable, intent(out) :: &
|
real(pReal), dimension(:,:), allocatable, intent(out) :: &
|
||||||
node0_elem !< node x,y,z coordinates (initially!)
|
node0_elem !< node x,y,z coordinates (initially!)
|
||||||
integer, dimension(:,:), allocatable, intent(out) :: &
|
integer, dimension(:,:), allocatable, intent(out) :: &
|
||||||
connectivity_elem
|
connectivity_elem
|
||||||
integer, dimension(:), allocatable, intent(out) :: &
|
integer, dimension(:), allocatable, intent(out) :: &
|
||||||
|
@ -188,7 +188,7 @@ subroutine inputRead(elem,node0_elem,connectivity_elem,microstructureAt,homogeni
|
||||||
matNumber !< material numbers for hypoelastic material
|
matNumber !< material numbers for hypoelastic material
|
||||||
character(len=pStringLen), dimension(:), allocatable :: inputFile !< file content, separated per lines
|
character(len=pStringLen), dimension(:), allocatable :: inputFile !< file content, separated per lines
|
||||||
|
|
||||||
character(len=64), dimension(:), allocatable :: &
|
character(len=pStringLen), dimension(:), allocatable :: &
|
||||||
nameElemSet
|
nameElemSet
|
||||||
integer, dimension(:,:), allocatable :: &
|
integer, dimension(:,:), allocatable :: &
|
||||||
mapElemSet !< list of elements in elementSet
|
mapElemSet !< list of elements in elementSet
|
||||||
|
@ -392,9 +392,9 @@ end subroutine inputRead_NelemSets
|
||||||
subroutine inputRead_mapElemSets(nameElemSet,mapElemSet,&
|
subroutine inputRead_mapElemSets(nameElemSet,mapElemSet,&
|
||||||
fileContent)
|
fileContent)
|
||||||
|
|
||||||
character(len=64), dimension(:), allocatable, intent(out) :: nameElemSet
|
character(len=pStringLen), dimension(:), allocatable, intent(out) :: nameElemSet
|
||||||
integer, dimension(:,:), allocatable, intent(out) :: mapElemSet
|
integer, dimension(:,:), allocatable, intent(out) :: mapElemSet
|
||||||
character(len=*), dimension(:), intent(in) :: fileContent !< file content, separated per lines
|
character(len=*), dimension(:), intent(in) :: fileContent !< file content, separated per lines
|
||||||
|
|
||||||
integer, allocatable, dimension(:) :: chunkPos
|
integer, allocatable, dimension(:) :: chunkPos
|
||||||
integer :: elemSet, NelemSets, maxNelemInSet,l
|
integer :: elemSet, NelemSets, maxNelemInSet,l
|
||||||
|
|
|
@ -77,6 +77,7 @@ module numerics
|
||||||
rotation_tol = 1.0e-12_pReal, & !< tolerance of rotation specified in loadcase, Default 1.0e-12: first guess
|
rotation_tol = 1.0e-12_pReal, & !< tolerance of rotation specified in loadcase, Default 1.0e-12: first guess
|
||||||
polarAlpha = 1.0_pReal, & !< polarization scheme parameter 0.0 < alpha < 2.0. alpha = 1.0 ==> AL scheme, alpha = 2.0 ==> accelerated scheme
|
polarAlpha = 1.0_pReal, & !< polarization scheme parameter 0.0 < alpha < 2.0. alpha = 1.0 ==> AL scheme, alpha = 2.0 ==> accelerated scheme
|
||||||
polarBeta = 1.0_pReal !< polarization scheme parameter 0.0 < beta < 2.0. beta = 1.0 ==> AL scheme, beta = 2.0 ==> accelerated scheme
|
polarBeta = 1.0_pReal !< polarization scheme parameter 0.0 < beta < 2.0. beta = 1.0 ==> AL scheme, beta = 2.0 ==> accelerated scheme
|
||||||
|
character(len=pStringLen), protected, public :: &
|
||||||
petsc_options = ''
|
petsc_options = ''
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue