From 432609ec1441932c259b6bd370cd5dbe8a550012 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Jul 2020 16:45:11 +0200 Subject: [PATCH] cleaning --- src/CPFEM.f90 | 6 ++--- src/DAMASK_marc.f90 | 23 ++++++++++---------- src/constitutive.f90 | 20 ++++++++--------- src/constitutive_plastic_isotropic.f90 | 10 ++++----- src/constitutive_plastic_kinehardening.f90 | 3 +-- src/constitutive_plastic_nonlocal.f90 | 4 ++-- src/crystallite.f90 | 3 +-- src/grid/grid_mech_spectral_polarisation.f90 | 1 - src/grid/spectral_utilities.f90 | 4 ++-- src/homogenization.f90 | 6 ++--- src/homogenization_mech_RGC.f90 | 1 + src/homogenization_mech_none.f90 | 12 +++++----- src/marc/discretization_marc.f90 | 1 - src/mesh/FEM_utilities.f90 | 4 ++-- src/mesh/discretization_mesh.f90 | 2 +- src/source_damage_isoDuctile.f90 | 1 - src/source_thermal_dissipation.f90 | 1 - src/source_thermal_externalheat.f90 | 1 - 18 files changed, 46 insertions(+), 57 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index ea249c879..e257f8e55 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -172,8 +172,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS elCP = mesh_FEM2DAMASK_elem(elFE) - if (debugCPFEM%basic .and. elCP == debugCPFEM%element & - .and. ip == debugCPFEM%ip) then + if (debugCPFEM%basic .and. elCP == debugCPFEM%element .and. ip == debugCPFEM%ip) then write(6,'(/,a)') '#############################################' write(6,'(a1,a22,1x,i8,a13)') '#','element', elCP, '#' write(6,'(a1,a22,1x,i8,a13)') '#','ip', ip, '#' @@ -249,8 +248,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS endif validCalculation if (debugCPFEM%extensive & - .and. (debugCPFEM%element == elCP .and. debugCPFEM%ip == ip) & - .or. .not. debugCPFEM%selective) then + .and. (debugCPFEM%element == elCP .and. debugCPFEM%ip == ip) .or. .not. debugCPFEM%selective) then write(6,'(a,i8,1x,i2,/,12x,6(f10.3,1x)/)') & '<< CPFEM >> stress/MPa at elFE ip ', elFE, ip, CPFEM_cs(1:6,ip,elCP)*1.0e-6_pReal write(6,'(a,i8,1x,i2,/,6(12x,6(f10.3,1x)/))') & diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 233e684ee..f57344725 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -253,20 +253,12 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & logical, save :: & lastIncConverged = .false., & !< needs description outdatedByNewInc = .false., & !< needs description - CPFEM_init_done = .false. !< remember whether init has been done already + CPFEM_init_done = .false., & !< remember whether init has been done already + debug_basic = .true. class(tNode), pointer :: & debug_Marc ! pointer to Marc debug options - defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc - call omp_set_num_threads(1) ! no openMP - - if (.not. CPFEM_init_done) then - CPFEM_init_done = .true. - call CPFEM_initAll - endif - - debug_Marc => debug_root%get('marc',defaultVal=emptyList) - if(debug_Marc%contains('basic')) then + if(debug_basic) then write(6,'(a,/,i8,i8,i2)') ' MSC.MARC information on shape of element(2), IP:', m, nn write(6,'(a,2(i1))') ' Jacobian: ', ngens,ngens write(6,'(a,i1)') ' Direct stress: ', ndi @@ -281,6 +273,15 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & transpose(ffn1) endif + defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc + call omp_set_num_threads(1) ! no openMP + + if (.not. CPFEM_init_done) then + debug_Marc => debug_root%get('marc',defaultVal=emptyList) + debug_basic = debug_Marc%contains('basic') + CPFEM_init_done = .true. + call CPFEM_initAll + endif computationMode = 0 ! save initialization value, since it does not result in any calculation if (lovl == 4 ) then ! jacobian requested by marc diff --git a/src/constitutive.f90 b/src/constitutive.f90 index c8dfcf9d3..d920c481f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -40,7 +40,7 @@ module constitutive module subroutine plastic_isotropic_init end subroutine plastic_isotropic_init - + module subroutine plastic_phenopowerlaw_init end subroutine plastic_phenopowerlaw_init @@ -359,13 +359,12 @@ subroutine constitutive_init debug_constitutive debug_constitutive => debug_root%get('constitutive', defaultVal=emptyList) - debugConstitutive%basic = debug_constitutive%contains('basic') - debugConstitutive%extensive = debug_constitutive%contains('extensive') - debugConstitutive%selective = debug_constitutive%contains('selective') - debugConstitutive%element = debug_root%get_asInt('element',defaultVal = 1) - debugConstitutive%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1) - debugConstitutive%grain = debug_root%get_asInt('grain',defaultVal = 1) - + debugConstitutive%basic = debug_constitutive%contains('basic') + debugConstitutive%extensive = debug_constitutive%contains('extensive') + debugConstitutive%selective = debug_constitutive%contains('selective') + debugConstitutive%element = debug_root%get_asInt('element',defaultVal = 1) + debugConstitutive%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1) + debugConstitutive%grain = debug_root%get_asInt('grain',defaultVal = 1) !-------------------------------------------------------------------------------------------------- ! initialized plasticity @@ -501,8 +500,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & tme !< thermal member position integer :: & i, j, instance, of - - + ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) @@ -577,7 +575,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & integer :: & k, i, j, & instance, of - + Li = 0.0_pReal dLi_dS = 0.0_pReal dLi_dFi = 0.0_pReal diff --git a/src/constitutive_plastic_isotropic.f90 b/src/constitutive_plastic_isotropic.f90 index 7cd529e9b..60f40fe37 100644 --- a/src/constitutive_plastic_isotropic.f90 +++ b/src/constitutive_plastic_isotropic.f90 @@ -161,7 +161,7 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) integer, intent(in) :: & instance, & of - + real(pReal), dimension(3,3) :: & Mp_dev !< deviatoric part of the Mandel stress real(pReal) :: & @@ -182,8 +182,7 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) Lp = dot_gamma/prm%M * Mp_dev/norm_Mp_dev #ifdef DEBUG - if (debugConstitutive%extensive & - .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then + if (debugConstitutive%extensive .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CONST isotropic >> Tstar (dev) / MPa', & transpose(Mp_dev)*1.0e-6_pReal write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Mp_dev*1.0e-6_pReal @@ -222,7 +221,7 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) integer, intent(in) :: & instance, & of - + real(pReal) :: & tr !< trace of spherical part of Mandel stress (= 3 x pressure) integer :: & @@ -238,8 +237,7 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) * tr * abs(tr)**(prm%n-1.0_pReal) #ifdef DEBUG - if (debugConstitutive%extensive & - .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then + if (debugConstitutive%extensive .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> pressure / MPa', tr/3.0_pReal*1.0e-6_pReal write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> gdot', prm%dot_gamma_0 * (3.0_pReal*prm%M*stt%xi(of))**(-prm%n) & * tr * abs(tr)**(prm%n-1.0_pReal) diff --git a/src/constitutive_plastic_kinehardening.f90 b/src/constitutive_plastic_kinehardening.f90 index 3b4ceec5a..d3e84cfe2 100644 --- a/src/constitutive_plastic_kinehardening.f90 +++ b/src/constitutive_plastic_kinehardening.f90 @@ -328,8 +328,7 @@ module subroutine plastic_kinehardening_deltaState(Mp,instance,of) #ifdef DEBUG if (debugConstitutive%extensive & - .and. (of == prm%of_debug & - .or. .not. debugConstitutive%selective)) then + .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then write(6,'(a)') '======= kinehardening delta state =======' write(6,*) sense,state(instance)%sense(:,of) endif diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index 5f9f63f24..ea55024b9 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -146,7 +146,7 @@ submodule(constitutive) plastic_nonlocal v_scr_pos, & v_scr_neg end type tNonlocalState - + type(tNonlocalState), allocatable, dimension(:) :: & deltaState, & dotState, & @@ -1157,7 +1157,7 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el) of, & ip, & !< current integration point el !< current element number - + integer :: & ph, & neighbor_instance, & !< instance of my neighbor's plasticity diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 32490b049..9222ce3f1 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -111,7 +111,6 @@ module crystallite type(tDebugOptions) :: debugCrystallite - procedure(integrateStateFPI), pointer :: integrateState public :: & @@ -143,7 +142,7 @@ subroutine crystallite_init eMax, & !< maximum number of elements myNcomponents !< number of components at current IP - class(tNode) , pointer :: & + class(tNode), pointer :: & num_crystallite, & debug_crystallite ! pointer to debug options for crystallite diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 555d5e0e1..7b77c56f5 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -537,7 +537,6 @@ subroutine formResidual(in, FandF_tau, & integer :: & i, j, k, e - !--------------------------------------------------------------------------------------------------- F => FandF_tau(1:3,1:3,1,& diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index b8db1778e..a6f4be069 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -188,9 +188,9 @@ subroutine spectral_utilities_init scalarSize = 1_C_INTPTR_T, & vecSize = 3_C_INTPTR_T, & tensorSize = 9_C_INTPTR_T - character(len=pStringLen) :: & + character(len=*), parameter :: & PETSCDEBUG = ' -snes_view -snes_monitor ' - class (tNode) , pointer :: & + class(tNode) , pointer :: & num_grid, & debug_grid ! pointer to grid debug options diff --git a/src/homogenization.f90 b/src/homogenization.f90 index c82e03bcb..7df37334c 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -228,7 +228,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) converged logical, dimension(2,discretization_nIP,discretization_nElem) :: & doneAndHappy - + #ifdef DEBUG if (debugHomog%basic) then @@ -489,7 +489,7 @@ subroutine partitionDeformation(subF,ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - + chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization @@ -525,7 +525,7 @@ function updateState(subdt,subF,ip,el) ip, & !< integration point el !< element number logical, dimension(2) :: updateState - + updateState = .true. chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index b485c607a..3993cd609 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -79,6 +79,7 @@ module subroutine mech_RGC_init(num_homogMech) class(tNode), pointer, intent(in) :: & num_homogMech !< pointer to mechanical homogenization numerics data + integer :: & Ninstance, & h, & diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mech_none.f90 index 6311ff770..0633f9b8c 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -9,29 +9,29 @@ submodule(homogenization) homogenization_mech_none contains !-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields, reads information from material configuration file +!> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- module subroutine mech_none_init - + integer :: & Ninstance, & h, & NofMyHomog - + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) - + do h = 1, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle - + NofMyHomog = count(material_homogenizationAt == h) homogState(h)%sizeState = 0 allocate(homogState(h)%state0 (0,NofMyHomog)) allocate(homogState(h)%subState0(0,NofMyHomog)) allocate(homogState(h)%state (0,NofMyHomog)) - + enddo end subroutine mech_none_init diff --git a/src/marc/discretization_marc.f90 b/src/marc/discretization_marc.f90 index 15db5b2a4..b0a5a9715 100644 --- a/src/marc/discretization_marc.f90 +++ b/src/marc/discretization_marc.f90 @@ -86,7 +86,6 @@ subroutine discretization_marc_init 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') - call inputRead(elem,node0_elem,connectivity_elem,microstructureAt,homogenizationAt) nElems = size(connectivity_elem,2) diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 9bd38bc30..643cb078f 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -107,7 +107,7 @@ subroutine FEM_utilities_init num_mesh, & debug_mesh ! pointer to mesh debug options integer :: structOrder !< order of displacement shape functions - character(len=pStringLen) :: & + character(len=*), parameter :: & PETSCDEBUG = ' -snes_view -snes_monitor ' PetscErrorCode :: ierr @@ -121,7 +121,7 @@ subroutine FEM_utilities_init ! set debugging parameters debug_mesh => debug_root%get('mesh',defaultVal=emptyList) debugPETSc = debug_mesh%contains('petsc') - + if(debugPETSc) write(6,'(3(/,a),/)') & ' Initializing PETSc with debug options: ', & trim(PETScDebug), & diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index dbc69e866..68c34be1f 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -96,7 +96,7 @@ subroutine discretization_mesh_init(restart) debug_element = debug_root%get_asInt('element',defaultVal=1) debug_ip = debug_root%get_asInt('integrationpoint',defaultVal=1) - + call DMPlexCreateFromFile(PETSC_COMM_WORLD,geometryFile,PETSC_TRUE,globalMesh,ierr) CHKERRQ(ierr) call DMGetDimension(globalMesh,dimPlex,ierr) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 1578fe50c..cf392fdc4 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -7,7 +7,6 @@ module source_damage_isoDuctile use prec use IO - use YAML_types use discretization use material use config diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 0a72032b2..8fa5ae0c7 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_thermal_dissipation use prec - use YAML_types use discretization use material use config diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index e64656be5..b83b29596 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_thermal_externalheat use prec - use YAML_types use discretization use material use config