diff --git a/code/CPFEM.f90 b/code/CPFEM.f90 index 3e7e3a4cc..f1ed4e9dc 100644 --- a/code/CPFEM.f90 +++ b/code/CPFEM.f90 @@ -1,7 +1,7 @@ ! Copyright 2011 Max-Planck-Institut für Eisenforschung GmbH ! ! This file is part of DAMASK, -! the Düsseldorf Advanced MAterial Simulation Kit. +! the Düsseldorf Advanced Material Simulation Kit. ! ! DAMASK is free software: you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by @@ -29,13 +29,13 @@ implicit none real(pReal), parameter :: CPFEM_odd_stress = 1e15_pReal, & CPFEM_odd_jacobian = 1e50_pReal -real(pReal), dimension (:,:,:), allocatable :: CPFEM_cs ! Cauchy stress -real(pReal), dimension (:,:,:,:), allocatable :: CPFEM_dcsdE ! Cauchy stress tangent -real(pReal), dimension (:,:,:,:), allocatable :: CPFEM_dcsdE_knownGood ! known good tangent +real(pReal), dimension (:,:,:), allocatable :: CPFEM_cs !> Cauchy stress +real(pReal), dimension (:,:,:,:), allocatable :: CPFEM_dcsdE !> Cauchy stress tangent +real(pReal), dimension (:,:,:,:), allocatable :: CPFEM_dcsdE_knownGood !> known good tangent -logical :: CPFEM_init_done = .false., & ! remember whether init has been done already - CPFEM_init_inProgress = .false., & ! remember whether first IP is currently performing init - CPFEM_calc_done = .false. ! remember whether first IP has already calced the results +logical :: CPFEM_init_done = .false., & !> remember whether init has been done already + CPFEM_init_inProgress = .false., & !> remember whether first IP is currently performing init + CPFEM_calc_done = .false. !> remember whether first IP has already calced the results CONTAINS diff --git a/code/constitutive.f90 b/code/constitutive.f90 index 211cb0f93..ac5b6f223 100644 --- a/code/constitutive.f90 +++ b/code/constitutive.f90 @@ -16,42 +16,41 @@ ! You should have received a copy of the GNU General Public License ! along with DAMASK. If not, see . ! -!############################################################## +!-------------------------------------------------------------------------------------------------- !* $Id$ -!************************************ -!* Module: CONSTITUTIVE * -!************************************ -!* contains: * -!* - constitutive equations * -!* - parameters definition * -!************************************ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!! Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief elasticity, plasticity, internal microstructure state +!-------------------------------------------------------------------------------------------------- -MODULE constitutive +module constitutive use prec, only: pInt, p_vec implicit none +!private type(p_vec), dimension(:,:,:), allocatable :: & - constitutive_state0, & ! pointer array to microstructure at start of FE inc - constitutive_partionedState0, & ! pointer array to microstructure at start of homogenization inc - constitutive_subState0, & ! pointer array to microstructure at start of crystallite inc - constitutive_state, & ! pointer array to current microstructure (end of converged time step) - constitutive_state_backup, & ! pointer array to backed up microstructure (end of converged time step) - constitutive_dotState, & ! pointer array to evolution of current microstructure - constitutive_deltaState, & ! pointer array to incremental change of current microstructure - constitutive_previousDotState,& ! pointer array to previous evolution of current microstructure - constitutive_previousDotState2,& ! pointer array to 2nd previous evolution of current microstructure - constitutive_dotState_backup, & ! pointer array to backed up evolution of current microstructure - constitutive_RK4dotState, & ! pointer array to evolution of microstructure defined by classical Runge-Kutta method - constitutive_aTolState ! pointer array to absolute state tolerance + constitutive_state0, & !< pointer array to microstructure at start of FE inc + constitutive_partionedState0, & !< pointer array to microstructure at start of homogenization inc + constitutive_subState0, & !< pointer array to microstructure at start of crystallite inc + constitutive_state, & !< pointer array to current microstructure (end of converged time step) + constitutive_state_backup, & !< pointer array to backed up microstructure (end of converged time step) + constitutive_dotState, & !< pointer array to evolution of current microstructure + constitutive_deltaState, & !< pointer array to incremental change of current microstructure + constitutive_previousDotState,& !< pointer array to previous evolution of current microstructure + constitutive_previousDotState2,& !< pointer array to 2nd previous evolution of current microstructure + constitutive_dotState_backup, & !< pointer array to backed up evolution of current microstructure + constitutive_RK4dotState, & !< pointer array to evolution of microstructure defined by classical Runge-Kutta method + constitutive_aTolState !< pointer array to absolute state tolerance - type(p_vec), dimension(:,:,:,:), allocatable :: & - constitutive_RKCK45dotState ! pointer array to evolution of microstructure used by Cash-Karp Runge-Kutta method +type(p_vec), dimension(:,:,:,:), allocatable :: & + constitutive_RKCK45dotState !< pointer array to evolution of microstructure used by Cash-Karp Runge-Kutta method - integer(pInt), dimension(:,:,:), allocatable :: & - constitutive_sizeDotState, & ! size of dotState array - constitutive_sizeState, & ! size of state array per grain - constitutive_sizePostResults ! size of postResults array per grain +integer(pInt), dimension(:,:,:), allocatable :: & + constitutive_sizeDotState, & !< size of dotState array + constitutive_sizeState, & !< size of state array per grain + constitutive_sizePostResults !< size of postResults array per grain integer(pInt) :: & constitutive_maxSizeDotState, & @@ -60,27 +59,28 @@ integer(pInt) :: & character (len=*), parameter, public :: constitutive_hooke_label = 'hooke' +public :: & + constitutive_init, & + constitutive_homogenizedC, & + constitutive_averageBurgers, & + constitutive_microstructure, & + constitutive_LpAndItsTangent, & + constitutive_TandItsTangent, & + constitutive_collectDotState, & + constitutive_collectDeltaState, & + constitutive_postResults + +private :: & + constitutive_hooke_TandItsTangent + contains -!**************************************** -!* - constitutive_init -!* - constitutive_homogenizedC -!* - constitutive_averageBurgers -!* - constitutive_microstructure -!* - constitutive_LpAndItsTangent -!* - constitutive_TandItsTangent -!* - constitutive_hooke_TandItsTangent -!* - constitutive_collectDotState -!* - constitutive_collectDeltaState -!* - constitutive_collectDotTemperature -!* - constitutive_postResults -!**************************************** -!************************************** -!* Module initialization * -!************************************** +!-------------------------------------------------------------------------------------------------- +!> @brief allocates arrays pointing to array of the various constitutive modules +!-------------------------------------------------------------------------------------------------- subroutine constitutive_init - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use debug, only: debug_level, & debug_constitutive, & debug_levelBasic @@ -113,12 +113,12 @@ subroutine constitutive_init implicit none integer(pInt), parameter :: fileunit = 200_pInt -integer(pInt) g, & ! grain number - i, & ! integration point number - e, & ! element number - gMax, & ! maximum number of grains - iMax, & ! maximum number of integration points - eMax, & ! maximum number of elements +integer(pInt) g, & ! grain number + i, & ! integration point number + e, & ! element number + gMax, & ! maximum number of grains + iMax, & ! maximum number of integration points + eMax, & ! maximum number of elements p, & s, & myInstance,& @@ -447,18 +447,18 @@ constitutive_maxSizePostResults = maxval(constitutive_sizePostResults) call flush(6) !$OMP END CRITICAL (write2out) -endsubroutine +end subroutine constitutive_init -function constitutive_homogenizedC(ipc,ip,el) !********************************************************************* !* This function returns the homogenized elacticity matrix * !* INPUT: * -!* - state : state variables * !* - ipc : component-ID of current integration point * !* - ip : current integration point * !* - el : current element * !********************************************************************* +function constitutive_homogenizedC(ipc,ip,el) + use prec, only: pReal use material, only: phase_plasticity,material_phase use constitutive_none @@ -494,10 +494,9 @@ function constitutive_homogenizedC(ipc,ip,el) end select -return -endfunction +end function constitutive_homogenizedC + -function constitutive_averageBurgers(ipc,ip,el) !********************************************************************* !* This function returns the average length of Burgers vector * !* INPUT: * @@ -506,6 +505,8 @@ function constitutive_averageBurgers(ipc,ip,el) !* - ip : current integration point * !* - el : current element * !********************************************************************* +function constitutive_averageBurgers(ipc,ip,el) + use prec, only: pReal use material, only: phase_plasticity,material_phase use constitutive_none @@ -541,8 +542,7 @@ function constitutive_averageBurgers(ipc,ip,el) end select -return -endfunction +end function constitutive_averageBurgers @@ -630,15 +630,15 @@ use constitutive_nonlocal, only: constitutive_nonlocal_label, & implicit none !*** input variables ***! -integer(pInt), intent(in):: ipc, & ! component-ID of current integration point - ip, & ! current integration point - el ! current element +integer(pInt), intent(in):: ipc, & ! component-ID of current integration point + ip, & ! current integration point + el ! current element real(pReal), intent(in) :: Temperature -real(pReal), dimension(6), intent(in) :: Tstar_v ! 2nd Piola-Kirchhoff stress +real(pReal), dimension(6), intent(in) :: Tstar_v ! 2nd Piola-Kirchhoff stress !*** output variables ***! -real(pReal), dimension(3,3), intent(out) :: Lp ! plastic velocity gradient -real(pReal), dimension(9,9), intent(out) :: dLp_dTstar ! derivative of Lp with respect to Tstar (4th-order tensor) +real(pReal), dimension(3,3), intent(out) :: Lp ! plastic velocity gradient +real(pReal), dimension(9,9), intent(out) :: dLp_dTstar ! derivative of Lp with respect to Tstar (4th-order tensor) !*** local variables ***! @@ -666,7 +666,7 @@ select case (phase_plasticity(material_phase(ipc,ip,el))) end select -endsubroutine +end subroutine constitutive_LpAndItsTangent @@ -700,9 +700,7 @@ subroutine constitutive_TandItsTangent(T, dT_dFe, Fe, ipc, ip, el) end select -return - -endsubroutine constitutive_TandItsTangent +end subroutine constitutive_TandItsTangent @@ -831,7 +829,7 @@ if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) then !$OMP END CRITICAL (debugTimingDotState) endif -endsubroutine +end subroutine constitutive_collectDotState !********************************************************************* @@ -914,7 +912,7 @@ if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) then !$OMP END CRITICAL (debugTimingDeltaState) endif -endsubroutine +end subroutine constitutive_collectDeltaState @@ -999,11 +997,10 @@ if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then !$OMP END CRITICAL (debugTimingDotTemperature) endif -endfunction +end function constitutive_dotTemperature -function constitutive_postResults(Tstar_v, Fe, Temperature, dt, ipc, ip, el) !********************************************************************* !* return array of constitutive results * !* INPUT: * @@ -1013,6 +1010,7 @@ function constitutive_postResults(Tstar_v, Fe, Temperature, dt, ipc, ip, el) !* - ip : current integration point * !* - el : current element * !********************************************************************* +function constitutive_postResults(Tstar_v, Fe, Temperature, dt, ipc, ip, el) use prec, only: pReal use mesh, only: mesh_NcpElems, & mesh_maxNips @@ -1073,7 +1071,7 @@ select case (phase_plasticity(material_phase(ipc,ip,el))) constitutive_dotstate(ipc,ip,el), ipc, ip, el) end select -endfunction +end function constitutive_postResults -END MODULE +end module constitutive diff --git a/code/crystallite.f90 b/code/crystallite.f90 index 55f6846f7..62def6ebf 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -554,14 +554,14 @@ if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt& .and. debug_i > 0 .and. debug_i <= mesh_maxNips & .and. debug_g > 0 .and. debug_g <= homogenization_maxNgrains) then !$OMP CRITICAL (write2out) - write (6,*) - write (6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> crystallite start at el ip g ', debug_e, debug_i, debug_g - write (6,'(a,/,12x,f14.9)') '<< CRYST >> Temp0', crystallite_partionedTemperature0(debug_g,debug_i,debug_e) - write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> F0 ', & + write(6,*) + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> crystallite start at el ip g ', debug_e, debug_i, debug_g + write(6,'(a,/,12x,f14.9)') '<< CRYST >> Temp0', crystallite_partionedTemperature0(debug_g,debug_i,debug_e) + write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> F0 ', & math_transpose33(crystallite_partionedF0(1:3,1:3,debug_g,debug_i,debug_e)) - write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp0', & + write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp0', & math_transpose33(crystallite_partionedFp0(1:3,1:3,debug_g,debug_i,debug_e)) - write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Lp0', & + write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Lp0', & math_transpose33(crystallite_partionedLp0(1:3,1:3,debug_g,debug_i,debug_e)) !$OMP END CRITICAL (write2out) endif @@ -720,8 +720,8 @@ enddo if (.not. crystallite_converged(g,i,e)) then ! respond fully elastically (might be not required due to becoming terminally ill anyway) #ifndef _OPENMP if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then - write (6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> no convergence : respond fully elastic at el ip g ',e,i,g - write (6,*) + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> no convergence : respond fully elastic at el ip g ',e,i,g + write(6,*) endif #endif invFp = math_inv33(crystallite_partionedFp0(1:3,1:3,g,i,e)) @@ -734,12 +734,12 @@ enddo if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .or. .not. iand(debug_level(debug_crystallite),debug_levelSelective) /= 0_pInt)) then - write (6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> central solution of cryst_StressAndTangent at el ip g ',e,i,g - write (6,*) - write (6,'(a,/,3(12x,3(f12.4,1x)/))') '<< CRYST >> P / MPa', math_transpose33(crystallite_P(1:3,1:3,g,i,e))/1.0e6_pReal - write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp', math_transpose33(crystallite_Fp(1:3,1:3,g,i,e)) - write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Lp', math_transpose33(crystallite_Lp(1:3,1:3,g,i,e)) - write (6,*) + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> central solution of cryst_StressAndTangent at el ip g ',e,i,g + write(6,*) + write(6,'(a,/,3(12x,3(f12.4,1x)/))') '<< CRYST >> P / MPa', math_transpose33(crystallite_P(1:3,1:3,g,i,e))/1.0e6_pReal + write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp', math_transpose33(crystallite_Fp(1:3,1:3,g,i,e)) + write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Lp', math_transpose33(crystallite_Lp(1:3,1:3,g,i,e)) + write(6,*) endif #endif enddo diff --git a/code/homogenization.f90 b/code/homogenization.f90 index 50470ab11..7ba989de0 100644 --- a/code/homogenization.f90 +++ b/code/homogenization.f90 @@ -322,13 +322,13 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt .and. & debug_e > 0 .and. debug_e <= mesh_NcpElems .and. debug_i > 0 .and. debug_i <= mesh_maxNips) then !$OMP CRITICAL (write2out) - write (6,*) - write (6,'(a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i - write (6,'(a,/,12x,f14.9)') '<< HOMOG >> Temp0', & + write(6,*) + write(6,'(a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i + write(6,'(a,/,12x,f14.9)') '<< HOMOG >> Temp0', & materialpoint_Temperature(debug_i,debug_e) - write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & + write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & math_transpose33(materialpoint_F0(1:3,1:3,debug_i,debug_e)) - write (6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', & + write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', & math_transpose33(materialpoint_F(1:3,1:3,debug_i,debug_e)) !$OMP END CRITICAL (write2out) endif @@ -553,9 +553,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) !$OMP END PARALLEL DO else !$OMP CRITICAL (write2out) - write (6,*) - write (6,'(a)') '<< HOMOG >> Material Point terminally ill' - write (6,*) + write(6,*) + write(6,'(a)') '<< HOMOG >> Material Point terminally ill' + write(6,*) !$OMP END CRITICAL (write2out) endif return diff --git a/code/lattice.f90 b/code/lattice.f90 index 6b3ec026c..6969a913b 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -45,38 +45,38 @@ module lattice lattice_maxNtwin = 24_pInt, & !< max # of twin systems over lattice structures lattice_maxNinteraction = 30_pInt !< max # of interaction types (in hardening matrix part) - integer(pInt), allocatable, dimension(:,:), public :: & + integer(pInt), allocatable, dimension(:,:), protected, public :: & lattice_NslipSystem, & !< # of slip systems in each family lattice_NtwinSystem !< # of twin systems in each family - integer(pInt), allocatable, dimension(:,:,:), public :: & + integer(pInt), allocatable, dimension(:,:,:), protected, public :: & lattice_interactionSlipSlip, & !< interaction type between slip/slip lattice_interactionSlipTwin, & !< interaction type between slip/twin lattice_interactionTwinSlip, & !< interaction type between twin/slip lattice_interactionTwinTwin !< interaction type between twin/twin - real(pReal), allocatable, dimension(:,:,:,:), public :: & + real(pReal), allocatable, dimension(:,:,:,:), protected, public :: & lattice_Sslip !< Schmid matrices, normal, shear direction and d x n of slip systems - real(pReal), allocatable, dimension(:,:,:), public :: & + real(pReal), allocatable, dimension(:,:,:), protected, public :: & lattice_Sslip_v, & lattice_sn, & lattice_sd, & lattice_st ! rotation and Schmid matrices, normal, shear direction and d x n of twin systems - real(pReal), allocatable, dimension(:,:,:,:), public :: & + real(pReal), allocatable, dimension(:,:,:,:), protected, public :: & lattice_Stwin, & lattice_Qtwin - real(pReal), allocatable, dimension(:,:,:), public :: & + real(pReal), allocatable, dimension(:,:,:), protected, public :: & lattice_Stwin_v, & lattice_tn, & lattice_td, & lattice_tt - real(pReal), allocatable, dimension(:,:), public :: & + real(pReal), allocatable, dimension(:,:), protected, public :: & lattice_shearTwin !< characteristic twin shear integer(pInt), private :: & diff --git a/code/material.f90 b/code/material.f90 index 91dfeb3e6..b972eab20 100644 --- a/code/material.f90 +++ b/code/material.f90 @@ -155,31 +155,31 @@ subroutine material_init call material_parseHomogenization(fileunit,material_partHomogenization) if (iand(myDebug,debug_levelBasic) /= 0_pInt) then !$OMP CRITICAL (write2out) - write (6,*) 'Homogenization parsed' + write(6,*) 'Homogenization parsed' !$OMP END CRITICAL (write2out) endif call material_parseMicrostructure(fileunit,material_partMicrostructure) if (iand(myDebug,debug_levelBasic) /= 0_pInt) then !$OMP CRITICAL (write2out) - write (6,*) 'Microstructure parsed' + write(6,*) 'Microstructure parsed' !$OMP END CRITICAL (write2out) endif call material_parseCrystallite(fileunit,material_partCrystallite) if (iand(myDebug,debug_levelBasic) /= 0_pInt) then !$OMP CRITICAL (write2out) - write (6,*) 'Crystallite parsed' + write(6,*) 'Crystallite parsed' !$OMP END CRITICAL (write2out) endif call material_parseTexture(fileunit,material_partTexture) if (iand(myDebug,debug_levelBasic) /= 0_pInt) then !$OMP CRITICAL (write2out) - write (6,*) 'Texture parsed' + write(6,*) 'Texture parsed' !$OMP END CRITICAL (write2out) endif call material_parsePhase(fileunit,material_partPhase) if (iand(myDebug,debug_levelBasic) /= 0_pInt) then !$OMP CRITICAL (write2out) - write (6,*) 'Phase parsed' + write(6,*) 'Phase parsed' !$OMP END CRITICAL (write2out) endif close(fileunit) @@ -202,27 +202,27 @@ subroutine material_init enddo if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then !$OMP CRITICAL (write2out) - write (6,*) - write (6,*) 'MATERIAL configuration' - write (6,*) - write (6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' + write(6,*) + write(6,*) 'MATERIAL configuration' + write(6,*) + write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' do i = 1_pInt,material_Nhomogenization - write (6,'(1x,a32,1x,a16,1x,i4)') homogenization_name(i),homogenization_type(i),homogenization_Ngrains(i) + write(6,'(1x,a32,1x,a16,1x,i4)') homogenization_name(i),homogenization_type(i),homogenization_Ngrains(i) enddo - write (6,*) - write (6,'(a32,1x,a11,1x,a12,1x,a13)') 'microstructure ','crystallite','constituents','homogeneous' + write(6,*) + write(6,'(a32,1x,a11,1x,a12,1x,a13)') 'microstructure ','crystallite','constituents','homogeneous' do i = 1_pInt,material_Nmicrostructure - write (6,'(a32,4x,i4,8x,i4,8x,l1)') microstructure_name(i), & + write(6,'(a32,4x,i4,8x,i4,8x,l1)') microstructure_name(i), & microstructure_crystallite(i), & microstructure_Nconstituents(i), & microstructure_elemhomo(i) if (microstructure_Nconstituents(i) > 0_pInt) then do j = 1_pInt,microstructure_Nconstituents(i) - write (6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(j,i)),& + write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(j,i)),& texture_name(microstructure_texture(j,i)),& microstructure_fraction(j,i) enddo - write (6,*) + write(6,*) endif enddo !$OMP END CRITICAL (write2out) @@ -744,10 +744,10 @@ subroutine material_populateGrains if (iand(myDebug,debug_levelBasic) /= 0_pInt) then !$OMP CRITICAL (write2out) - write (6,*) - write (6,*) 'MATERIAL grain population' - write (6,*) - write (6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#' + write(6,*) + write(6,*) 'MATERIAL grain population' + write(6,*) + write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#' !$OMP END CRITICAL (write2out) endif do homog = 1_pInt,material_Nhomogenization ! loop over homogenizations @@ -757,8 +757,8 @@ subroutine material_populateGrains myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate if (iand(myDebug,debug_levelBasic) /= 0_pInt) then !$OMP CRITICAL (write2out) - write (6,*) - write (6,'(a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains + write(6,*) + write(6,'(a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains !$OMP END CRITICAL (write2out) endif