diff --git a/code/CPFEM.f90 b/code/CPFEM.f90 index c4fa15657..7f375da4f 100644 --- a/code/CPFEM.f90 +++ b/code/CPFEM.f90 @@ -217,13 +217,17 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt cp_en = mesh_FEasCP('elem',element) selectiveDebugger = (cp_en == debug_e .and. IP == debug_i) - if (debugger .and. selectiveDebugger) then + if (selectiveDebugger) then !$OMP CRITICAL (write2out) write(6,*) - write(6,*) '#####################################' - write(6,'(a10,x,f8.4,x,a10,x,f8.4,x,a10,x,i6,x,a10,x,i3,x,a16,x,i2,x,a16,x,i2)') & - 'theTime',theTime,'theDelta',theDelta,'theInc',theInc,'cycleCounter',cycleCounter,'computationMode',mode - write(6,*) '#####################################' + write(6,'(a)') '#######################################################' + write(6,'(a32,x,i5,x,i2)') 'reporting for element, ip:',cp_en,IP + write(6,'(a32,x,f15.7)') 'theTime',theTime + write(6,'(a32,x,f15.7)') 'theDelta',theDelta + write(6,'(a32,x,i8)') 'theInc',theInc + write(6,'(a32,x,i8)') 'cycleCounter',cycleCounter + write(6,'(a32,x,i8)') 'computationMode',mode + write(6,'(a)') '#######################################################' call flush (6) !$OMP END CRITICAL (write2out) endif @@ -243,9 +247,10 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt j = 1:mesh_maxNips, & k = 1:mesh_NcpElems ) & constitutive_state0(i,j,k)%p = constitutive_state(i,j,k)%p ! microstructure of crystallites - if (debugger .and. selectiveDebugger) then + if (selectiveDebugger) then !$OMP CRITICAL (write2out) - write(6,'(a16,i2,x,i5,/,4(3(e20.8,x),/))') 'aged state at 1 ',IP,cp_en, constitutive_state(1,IP,cp_en)%p + write(6,'(a32,x,i8,x,i2,/,4(3(e20.8,x),/))') '°°° AGED state of grain 1, element ip',cp_en,IP, & + constitutive_state(1,IP,cp_en)%p !$OMP END CRITICAL (write2out) endif do k = 1,mesh_NcpElems @@ -265,14 +270,15 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt ! deformation gradient outdated or any actual deformation gradient differs more than relevantStrain from the stored one if (terminallyIll .or. outdatedFFN1 .or. any(abs(ffn1 - materialpoint_F(:,:,IP,cp_en)) > defgradTolerance)) then if (.not. terminallyIll .and. .not. outdatedFFN1) then - if (debugger) then - !$OMP CRITICAL (write2out) - write(6,'(a11,x,i2,x,i5,x,a12,/,3(3(f10.6,x),/))') 'outdated at',IP,cp_en,'; FFN1 now:',ffn1(:,1),ffn1(:,2),ffn1(:,3) - !$OMP END CRITICAL (write2out) - endif + !$OMP CRITICAL (write2out) + write(6,'(a32,x,i5,x,i2)') '°°° OUTDATED at element ip',cp_en,IP + write(6,'(a32,/,3(3(f10.6,x),/))') ' FFN1 now:',ffn1(:,1),ffn1(:,2),ffn1(:,3) + !$OMP END CRITICAL (write2out) outdatedFFN1 = .true. endif - CPFEM_cs(:,IP,cp_en) = CPFEM_odd_stress + call random_number(rnd) + if (rnd < 0.5_pReal) rnd = 1.0_pReal - rnd + CPFEM_cs(:,IP,cp_en) = rnd*CPFEM_odd_stress CPFEM_dcsde(:,:,IP,cp_en) = CPFEM_odd_jacobian*math_identity2nd(6) ! deformation gradient is not outdated @@ -307,8 +313,10 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt CPFEM_calc_done = .true. endif - if (terminallyIll) then - CPFEM_cs(:,IP,cp_en) = CPFEM_odd_stress + if ( terminallyIll ) then + call random_number(rnd) + if (rnd < 0.5_pReal) rnd = 1.0_pReal - rnd + CPFEM_cs(:,IP,cp_en) = rnd*CPFEM_odd_stress CPFEM_dcsde(:,:,IP,cp_en) = CPFEM_odd_jacobian*math_identity2nd(6) else ! translate from P to CS @@ -334,7 +342,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt endif endif - ! --+>> COLLECTION OF FEM INPUT WITH RETURNING OF ODD STRESS AND JACOBIAN <<+-- + ! --+>> COLLECTION OF FEM INPUT WITH RETURNING OF RANDOMIZED ODD STRESS AND JACOBIAN <<+-- case (3,4,5) if (mode == 4) then CPFEM_dcsde_knownGood = CPFEM_dcsde ! --+>> BACKUP JACOBIAN FROM FORMER CONVERGED INC @@ -353,8 +361,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt ! --+>> RECYCLING OF FORMER RESULTS (MARC SPECIALTY) <<+-- case (6) ! do nothing + ! --+>> RESTORE CONSISTENT JACOBIAN FROM FORMER CONVERGED INC case (7) - CPFEM_dcsde = CPFEM_dcsde_knownGood ! --+>> RESTORE CONSISTENT JACOBIAN FROM FORMER CONVERGED INC + CPFEM_dcsde = CPFEM_dcsde_knownGood end select @@ -363,12 +372,13 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt jacobian(:,:) = CPFEM_dcsdE(:,:,IP,cp_en) ! copy P and dPdF to the output variables - pstress(:,:) = materialpoint_P(:,:,IP,cp_en) + pstress(:,:) = materialpoint_P(:,:,IP,cp_en) dPdF(:,:,:,:) = materialpoint_dPdF(:,:,:,:,IP,cp_en) - if (debugger .and. selectiveDebugger) then + if ((debugger .and. selectiveDebugger) .and. & + mode < 6) then !$OMP CRITICAL (write2out) - write(6,'(a16,x,i2,x,a2,x,i4,/,6(f10.3,x)/)') 'stress/MPa at ip', IP, 'el', cp_en, cauchyStress/1e6 - write(6,'(a18,x,i2,x,a2,x,i4,/,6(6(f10.3,x)/))') 'jacobian/GPa at ip', IP, 'el', cp_en, jacobian/1e9 + write(6,'(a,x,i2,x,a,x,i4,/,6(f10.3,x)/)') 'stress/MPa at ip', IP, 'el', cp_en, cauchyStress/1e6 + write(6,'(a,x,i2,x,a,x,i4,/,6(6(f10.3,x)/))') 'jacobian/GPa at ip', IP, 'el', cp_en, jacobian/1e9 call flush(6) !$OMP END CRITICAL (write2out) endif diff --git a/code/debug.f90 b/code/debug.f90 index 4969e1051..200ec3ff2 100644 --- a/code/debug.f90 +++ b/code/debug.f90 @@ -11,18 +11,18 @@ integer(pInt), dimension(:), allocatable :: debug_CrystalliteLoopDistribution integer(pInt), dimension(:), allocatable :: debug_MaterialpointStateLoopDistribution integer(pInt), dimension(:), allocatable :: debug_MaterialpointLoopDistribution - integer(pLongInt) :: debug_cumLpTicks = 0_pInt - integer(pLongInt) :: debug_cumDotStateTicks = 0_pInt + integer(pLongInt) :: debug_cumLpTicks = 0_pInt + integer(pLongInt) :: debug_cumDotStateTicks = 0_pInt integer(pLongInt) :: debug_cumDotTemperatureTicks = 0_pInt - integer(pInt) :: debug_cumLpCalls = 0_pInt - integer(pInt) :: debug_cumDotStateCalls = 0_pInt + integer(pInt) :: debug_cumLpCalls = 0_pInt + integer(pInt) :: debug_cumDotStateCalls = 0_pInt integer(pInt) :: debug_cumDotTemperatureCalls = 0_pInt integer(pInt) :: debug_e = 1_pInt integer(pInt) :: debug_i = 1_pInt integer(pInt) :: debug_g = 1_pInt logical :: selectiveDebugger = .false. - logical :: verboseDebugger = .false. - logical :: debugger = .false. + logical :: verboseDebugger = .false. + logical :: debugger = .false. logical :: distribution_init = .false. CONTAINS @@ -46,12 +46,12 @@ subroutine debug_init() write(6,*) '$Id$' write(6,*) - allocate(debug_StressLoopDistribution(nStress)) ; debug_StressLoopDistribution = 0_pInt - allocate(debug_CrystalliteStateLoopDistribution(nState)); debug_CrystalliteStateLoopDistribution = 0_pInt - allocate(debug_StiffnessStateLoopDistribution(nState)) ; debug_StiffnessStateLoopDistribution = 0_pInt - allocate(debug_CrystalliteLoopDistribution(nCryst+1)) ; debug_CrystalliteLoopDistribution = 0_pInt + allocate(debug_StressLoopDistribution(nStress)) ; debug_StressLoopDistribution = 0_pInt + allocate(debug_CrystalliteStateLoopDistribution(nState)) ; debug_CrystalliteStateLoopDistribution = 0_pInt + allocate(debug_StiffnessStateLoopDistribution(nState)) ; debug_StiffnessStateLoopDistribution = 0_pInt + allocate(debug_CrystalliteLoopDistribution(nCryst+1)) ; debug_CrystalliteLoopDistribution = 0_pInt allocate(debug_MaterialpointStateLoopDistribution(nMPstate)) ; debug_MaterialpointStateLoopDistribution = 0_pInt - allocate(debug_MaterialpointLoopDistribution(nHomog+1)) ; debug_MaterialpointLoopDistribution = 0_pInt + allocate(debug_MaterialpointLoopDistribution(nHomog+1)) ; debug_MaterialpointLoopDistribution = 0_pInt endsubroutine !******************************************************************** @@ -98,21 +98,21 @@ endsubroutine write(6,*) write(6,*) 'DEBUG Info' write(6,*) - write(6,'(a33,x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls + write(6,'(a33,x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls if (debug_cumLpCalls > 0_pInt) then write(6,'(a33,x,f12.3)') 'total CPU time/s :',dble(debug_cumLpTicks)/tickrate write(6,'(a33,x,f12.6)') 'avg CPU time/microsecs per call :',& dble(debug_cumLpTicks)*1.0e6_pReal/tickrate/debug_cumLpCalls endif write(6,*) - write(6,'(a33,x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls + write(6,'(a33,x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls if (debug_cumdotStateCalls > 0_pInt) then write(6,'(a33,x,f12.3)') 'total CPU time/s :',dble(debug_cumDotStateTicks)/tickrate write(6,'(a33,x,f12.6)') 'avg CPU time/microsecs per call :',& dble(debug_cumDotStateTicks)*1.0e6_pReal/tickrate/debug_cumDotStateCalls endif write(6,*) - write(6,'(a33,x,i12)') 'total calls to dotTemperature :',debug_cumDotTemperatureCalls + write(6,'(a33,x,i12)') 'total calls to dotTemperature :',debug_cumDotTemperatureCalls if (debug_cumdotTemperatureCalls > 0_pInt) then write(6,'(a33,x,f12.3)') 'total CPU time/s :', dble(debug_cumDotTemperatureTicks)/tickrate write(6,'(a33,x,f12.6)') 'avg CPU time/microsecs per call :',& @@ -121,7 +121,7 @@ endsubroutine integral = 0_pInt write(6,*) - write(6,*) 'distribution_StressLoop :' + write(6,*) 'distribution_StressLoop :' do i=1,nStress if (debug_StressLoopDistribution(i) /= 0) then integral = integral + i*debug_StressLoopDistribution(i) @@ -132,7 +132,7 @@ endsubroutine integral = 0_pInt write(6,*) - write(6,*) 'distribution_CrystalliteStateLoop :' + write(6,*) 'distribution_CrystalliteStateLoop :' do i=1,nState if (debug_CrystalliteStateLoopDistribution(i) /= 0) then integral = integral + i*debug_CrystalliteStateLoopDistribution(i) @@ -143,18 +143,7 @@ endsubroutine integral = 0_pInt write(6,*) - write(6,*) 'distribution_StiffnessStateLoop :' - do i=1,nState - if (debug_StiffnessStateLoopDistribution(i) /= 0) then - integral = integral + i*debug_StiffnessStateLoopDistribution(i) - write(6,'(i25,x,i10)') i,debug_StiffnessStateLoopDistribution(i) - endif - enddo - write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_StiffnessStateLoopDistribution) - - integral = 0_pInt - write(6,*) - write(6,*) 'distribution_CrystalliteLoop :' + write(6,*) 'distribution_CrystalliteCutbackLoop :' do i=1,nCryst+1 if (debug_CrystalliteLoopDistribution(i) /= 0) then integral = integral + i*debug_CrystalliteLoopDistribution(i) @@ -166,12 +155,23 @@ endsubroutine endif enddo write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution) - write(6,*) + integral = 0_pInt + write(6,*) + write(6,*) 'distribution_StiffnessStateLoop :' + do i=1,nState + if (debug_StiffnessStateLoopDistribution(i) /= 0) then + integral = integral + i*debug_StiffnessStateLoopDistribution(i) + write(6,'(i25,x,i10)') i,debug_StiffnessStateLoopDistribution(i) + endif + enddo + write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_StiffnessStateLoopDistribution) + !* Material point loop counter <<>> integral = 0_pInt write(6,*) - write(6,*) 'distribution_MaterialpointStateLoop :' + write(6,*) + write(6,*) 'distribution_MaterialpointStateLoop :' do i=1,nMPstate if (debug_MaterialpointStateLoopDistribution(i) /= 0) then integral = integral + i*debug_MaterialpointStateLoopDistribution(i) @@ -179,11 +179,10 @@ endsubroutine endif enddo write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_MaterialpointStateLoopDistribution) - write(6,*) integral = 0_pInt write(6,*) - write(6,*) 'distribution_MaterialpointLoop :' + write(6,*) 'distribution_MaterialpointCutbackLoop :' do i=1,nHomog+1 if (debug_MaterialpointLoopDistribution(i) /= 0) then integral = integral + i*debug_MaterialpointLoopDistribution(i) @@ -195,8 +194,8 @@ endsubroutine endif enddo write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution) - write(6,*) + write(6,*) endsubroutine diff --git a/code/homogenization.f90 b/code/homogenization.f90 index 74b2ec5dd..2c841b1b9 100644 --- a/code/homogenization.f90 +++ b/code/homogenization.f90 @@ -278,7 +278,7 @@ subroutine materialpoint_stressAndItsTangent(& if (debugger) then write (6,*) write (6,*) 'Material Point start' - write (6,'(a,/,(f12.7,x))') 'Temp0 of 1 1' ,materialpoint_Temperature(1,1) + write (6,'(a,/,(f12.7,x))') 'Temp0 of 1 1',materialpoint_Temperature(1,1) write (6,'(a,/,3(3(f12.7,x)/))') 'F0 of 1 1',materialpoint_F0(1:3,:,1,1) write (6,'(a,/,3(3(f12.7,x)/))') 'F of 1 1',materialpoint_F(1:3,:,1,1) write (6,'(a,/,3(3(f12.7,x)/))') 'Fp0 of 1 1 1',crystallite_Fp0(1:3,:,1,1,1) @@ -316,23 +316,22 @@ subroutine materialpoint_stressAndItsTangent(& ! ------ cutback loop ------ - do while (any(materialpoint_subStep(:,FEsolving_execELem(1):FEsolving_execElem(2)) > subStepMinHomog)) ! cutback loop for material points + do while (.not. terminallyIll .and. & + any(materialpoint_subStep(:,FEsolving_execELem(1):FEsolving_execElem(2)) > subStepMinHomog)) ! cutback loop for material points -! write(6,'(a,/,125(8(f8.5,x),/))') 'mp_subSteps',materialpoint_subStep(:,FEsolving_execELem(1):FEsolving_execElem(2)) !$OMP PARALLEL DO - do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed + do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed myNgrains = homogenization_Ngrains(mesh_element(3,e)) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed selectiveDebugger = (e == debug_e .and. i == debug_i) - ! if our materialpoint converged or consists of only one single grain then we are either finished or have to wind forward - if ( materialpoint_converged(i,e) .or. (myNgrains == 1_pInt .and. materialpoint_subStep(i,e) <= 1.0_pReal) ) then + if ( materialpoint_converged(i,e) ) then if (verboseDebugger .and. selectiveDebugger) then !$OMP CRITICAL (write2out) - write(6,'(a21,f10.8,a34,f10.8,a37,/)') 'winding forward from ', & - materialpoint_subFrac(i,e), ' to current materialpoint_subFrac ', & - materialpoint_subFrac(i,e)+materialpoint_subStep(i,e),' in materialpoint_stressAndItsTangent' + write(6,'(a,x,f10.8,x,a,x,f10.8,x,a,/)') '°°° winding forward from', & + materialpoint_subFrac(i,e), 'to current materialpoint_subFrac', & + materialpoint_subFrac(i,e)+materialpoint_subStep(i,e),'in materialpoint_stressAndItsTangent' !$OMPEND CRITICAL (write2out) endif @@ -363,26 +362,31 @@ subroutine materialpoint_stressAndItsTangent(& ! materialpoint didn't converge, so we need a cutback here else - - materialpoint_subStep(i,e) = subStepSizeHomog * materialpoint_subStep(i,e) ! crystallite had severe trouble, so do a significant cutback - ! <> - - if (verboseDebugger .and. selectiveDebugger) then - !$OMP CRITICAL (write2out) - write(6,'(a82,f10.8,/)') 'cutback step in materialpoint_stressAndItsTangent with new materialpoint_subStep: ',& - materialpoint_subStep(i,e) - !$OMPEND CRITICAL (write2out) - endif - - ! restore... - crystallite_Temperature(1:myNgrains,i,e) = crystallite_partionedTemperature0(1:myNgrains,i,e) ! ...temperatures - crystallite_Fp(:,:,1:myNgrains,i,e) = crystallite_partionedFp0(:,:,1:myNgrains,i,e) ! ...plastic def grads - crystallite_Lp(:,:,1:myNgrains,i,e) = crystallite_partionedLp0(:,:,1:myNgrains,i,e) ! ...plastic velocity grads - crystallite_Tstar_v(:,1:myNgrains,i,e) = crystallite_partionedTstar0_v(:,1:myNgrains,i,e) ! ...2nd PK stress - forall (g = 1:myNgrains) constitutive_state(g,i,e)%p = constitutive_partionedState0(g,i,e)%p ! ...microstructures - if (homogenization_sizeState(i,e) > 0_pInt) & - homogenization_state(i,e)%p = homogenization_subState0(i,e)%p ! ...internal state of homog scheme - + if ( (myNgrains == 1_pInt .and. materialpoint_subStep(i,e) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite + subStepSizeHomog * materialpoint_subStep(i,e) <= subStepMinHomog ) then ! would require too small subStep + ! cutback makes no sense and... + terminallyIll = .true. ! ...one kills all + else ! cutback makes sense + materialpoint_subStep(i,e) = subStepSizeHomog * materialpoint_subStep(i,e) ! crystallite had severe trouble, so do a significant cutback + ! <> + + if (verboseDebugger .and. selectiveDebugger) then + !$OMP CRITICAL (write2out) + write(6,'(a,x,f10.8,/)') '°°° cutback step in materialpoint_stressAndItsTangent with new materialpoint_subStep:',& + materialpoint_subStep(i,e) + !$OMPEND CRITICAL (write2out) + endif + + ! restore... + crystallite_Temperature(1:myNgrains,i,e) = crystallite_partionedTemperature0(1:myNgrains,i,e) ! ...temperatures + ! ...initial def grad unchanged + crystallite_Fp(:,:,1:myNgrains,i,e) = crystallite_partionedFp0(:,:,1:myNgrains,i,e) ! ...plastic def grads + crystallite_Lp(:,:,1:myNgrains,i,e) = crystallite_partionedLp0(:,:,1:myNgrains,i,e) ! ...plastic velocity grads + crystallite_Tstar_v(:,1:myNgrains,i,e) = crystallite_partionedTstar0_v(:,1:myNgrains,i,e) ! ...2nd PK stress + forall (g = 1:myNgrains) constitutive_state(g,i,e)%p = constitutive_partionedState0(g,i,e)%p ! ...microstructures + if (homogenization_sizeState(i,e) > 0_pInt) & + homogenization_state(i,e)%p = homogenization_subState0(i,e)%p ! ...internal state of homog scheme + endif endif materialpoint_requested(i,e) = materialpoint_subStep(i,e) > subStepMinHomog @@ -392,8 +396,8 @@ subroutine materialpoint_stressAndItsTangent(& materialpoint_subdt(i,e) = materialpoint_subStep(i,e) * dt materialpoint_doneAndHappy(:,i,e) = (/.false.,.true./) endif - enddo - enddo + enddo ! loop IPs + enddo ! loop elements !$OMP END PARALLEL DO !* Checks for cutback/substepping loops: added <<>> @@ -406,9 +410,11 @@ subroutine materialpoint_stressAndItsTangent(& NiterationMPstate = 0_pInt - do while (any( materialpoint_requested(:,FEsolving_execELem(1):FEsolving_execElem(2)) & + do while (.not. terminallyIll .and. & + any( materialpoint_requested(:,FEsolving_execELem(1):FEsolving_execElem(2)) & .and. .not. materialpoint_doneAndHappy(1,:,FEsolving_execELem(1):FEsolving_execElem(2)) & - ) .and. NiterationMPstate < nMPstate) ! convergence loop for materialpoint + ) .and. & + NiterationMPstate < nMPstate) ! convergence loop for materialpoint NiterationMPstate = NiterationMPstate + 1 ! write(6,'(a,/,125(8(l,x),/))') 'material point request and not done', & @@ -476,32 +482,28 @@ subroutine materialpoint_stressAndItsTangent(& enddo ! cutback loop - ! calculate crystal orientations - call crystallite_orientations() - - ! check for non-performer: any(.not. converged) - ! replace everybody with odd response ? -!$OMP PARALLEL DO -elementLoop: do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed - if (materialpoint_converged(i,e)) then + if (.not. terminallyIll ) then + + call crystallite_orientations() ! calculate crystal orientations + !$OMP PARALLEL DO + do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed call homogenization_averageStressAndItsTangent(i,e) call homogenization_averageTemperature(i,e) - else - terminallyIll = .true. - write(6,'(a48,i4,i4,/)') 'homogenization terminally-ill ',i,e - exit elementLoop - endif - enddo - enddo elementLoop -!$OMP END PARALLEL DO - - - if (debugger) then + enddo; enddo + !$OMP END PARALLEL DO + + if (debugger) then + write (6,*) + write (6,'(a)') '°°° Material Point end' + write (6,*) + endif + else write (6,*) - write (6,*) 'Material Point end' + write (6,'(a)') '°°° Material Point terminally ill' write (6,*) + endif return diff --git a/code/mpie_cpfem_marc.f90 b/code/mpie_cpfem_marc.f90 index fa311106a..556ef5a9d 100644 --- a/code/mpie_cpfem_marc.f90 +++ b/code/mpie_cpfem_marc.f90 @@ -51,6 +51,8 @@ subroutine mpie_interface_init() write(6,*) '<<<+- mpie_cpfem_marc init -+>>>' write(6,*) '$Id$' write(6,*) + write(6,*) + write(6,*) return end subroutine @@ -247,7 +249,7 @@ subroutine hypela2(& terminallyIll = .false. cycleCounter = 0 !$OMP CRITICAL (write2out) - write (6,'(i6,x,i2,x,a)') n(1),nn,'<< hypela2 >> lastIncConverged + outdated'; call flush(6) + write (6,'(i6,x,i2,x,a)') n(1),nn,'<< hypela2 >> former increment converged..!'; call flush(6) !$OMP END CRITICAL (write2out) else if ( timinc < theDelta ) then ! cutBack @@ -261,11 +263,12 @@ subroutine hypela2(& calcMode(nn,cp_en) = .not. calcMode(nn,cp_en) ! ping pong (calc <--> collect) - if ( calcMode(nn,cp_en) ) then ! now calc + if ( calcMode(nn,cp_en) ) then ! now --- CALC --- if ( lastMode .neqv. calcMode(nn,cp_en) ) then ! first after ping pong call debug_reset() ! resets debugging - outdatedFFN1 = .false. - cycleCounter = cycleCounter + 1 + outdatedFFN1 = .false. + terminallyIll = .false. + cycleCounter = cycleCounter + 1 endif if ( outdatedByNewInc ) then outdatedByNewInc = .false. @@ -273,8 +276,9 @@ subroutine hypela2(& else computationMode = 2 ! plain calc endif - else ! now collect - if ( lastMode .neqv. calcMode(nn,cp_en) ) call debug_info() ! first after ping pong reports debugging + else ! now --- COLLECT --- + if ( lastMode .neqv. calcMode(nn,cp_en) .and. & + .not. terminallyIll ) call debug_info() ! first after ping pong reports (meaningful) debugging if ( lastIncConverged ) then lastIncConverged = .false. computationMode = 4 ! collect and backup Jacobian after convergence