From 54a68014ea9f8e1593d1871fecb8a739563b98f0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 24 Apr 2018 17:31:05 +0200 Subject: [PATCH 001/208] Ntrans not needed/used. Simplified storage of parameters --- PRIVATE | 2 +- src/plastic_phenopowerlaw.f90 | 286 ++++++++++++++-------------------- 2 files changed, 121 insertions(+), 167 deletions(-) diff --git a/PRIVATE b/PRIVATE index af8516892..7c69abfc5 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit af851689285b8c1a633495219abd9dbbd5a11c69 +Subproject commit 7c69abfc5bf54c083b9096511abde7d74b806b7f diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 229d03c26..368ce8bd5 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -24,36 +24,13 @@ module plastic_phenopowerlaw integer(pInt), dimension(:), allocatable, public, protected :: & plastic_phenopowerlaw_totalNslip, & !< no. of slip system used in simulation - plastic_phenopowerlaw_totalNtwin, & !< no. of twin system used in simulation - plastic_phenopowerlaw_totalNtrans !< no. of trans system used in simulation + plastic_phenopowerlaw_totalNtwin !< no. of twin system used in simulation + integer(pInt), dimension(:,:), allocatable, private :: & plastic_phenopowerlaw_Nslip, & !< active number of slip systems per family (input parameter, per family) - plastic_phenopowerlaw_Ntwin, & !< active number of twin systems per family (input parameter, per family) - plastic_phenopowerlaw_Ntrans !< active number of trans systems per family (input parameter, per family) + plastic_phenopowerlaw_Ntwin !< active number of twin systems per family (input parameter, per family) - real(pReal), dimension(:), allocatable, private :: & - plastic_phenopowerlaw_gdot0_slip, & !< reference shear strain rate for slip (input parameter) - plastic_phenopowerlaw_gdot0_twin, & !< reference shear strain rate for twin (input parameter) - plastic_phenopowerlaw_n_slip, & !< stress exponent for slip (input parameter) - plastic_phenopowerlaw_n_twin, & !< stress exponent for twin (input parameter) - plastic_phenopowerlaw_spr, & !< push-up factor for slip saturation due to twinning - plastic_phenopowerlaw_twinB, & - plastic_phenopowerlaw_twinC, & - plastic_phenopowerlaw_twinD, & - plastic_phenopowerlaw_twinE, & - plastic_phenopowerlaw_h0_SlipSlip, & !< reference hardening slip - slip (input parameter) - plastic_phenopowerlaw_h0_TwinSlip, & !< reference hardening twin - slip (input parameter) - plastic_phenopowerlaw_h0_TwinTwin, & !< reference hardening twin - twin (input parameter) - plastic_phenopowerlaw_a_slip, & - plastic_phenopowerlaw_aTolResistance, & - plastic_phenopowerlaw_aTolShear, & - plastic_phenopowerlaw_aTolTwinfrac, & - plastic_phenopowerlaw_aTolTransfrac, & - plastic_phenopowerlaw_Cnuc, & !< coefficient for strain-induced martensite nucleation - plastic_phenopowerlaw_Cdwp, & !< coefficient for double well potential - plastic_phenopowerlaw_Cgro, & !< coefficient for stress-assisted martensite growth - plastic_phenopowerlaw_deltaG !< free energy difference between austensite and martensite [MPa] real(pReal), dimension(:,:), allocatable, private :: & plastic_phenopowerlaw_tau0_slip, & !< initial critical shear stress for slip (input parameter, per family) @@ -89,6 +66,41 @@ module plastic_phenopowerlaw integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & plastic_phenopowerlaw_outputID !< ID of each post result output + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + gdot0_slip, & !< reference shear strain rate for slip + gdot0_twin, & !< reference shear strain rate for twin + n_slip, & !< stress exponent for slip + n_twin, & !< stress exponent for twin + spr, & !< push-up factor for slip saturation due to twinning + twinB, & + twinC, & + twinD, & + twinE, & + h0_SlipSlip, & !< reference hardening slip - slip + h0_TwinSlip, & !< reference hardening twin - slip + h0_TwinTwin, & !< reference hardening twin - twin + a_slip, & + aTolResistance = 1.0_pReal, & ! default absolute tolerance 1 Pa + aTolShear = 1.0e-6_pReal, & ! default absolute tolerance 1e-6 + aTolTwinfrac = 1.0e-6_pReal ! default absolute tolerance 1e-6 + integer(pInt), dimension(:), allocatable :: & + Nslip, & !< active number of slip systems per family + Ntwin !< active number of twin systems per family + real(pReal), dimension(:), allocatable :: & + tau0_slip, & !< initial critical shear stress for slip + tau0_twin, & !< initial critical shear stress for twin + tausat_slip, & !< maximum critical shear stress for slip + nonSchmidCoeff, & + H_int, & !< per family hardening activity (optional) + + interaction_SlipSlip, & !< slip resistance from slip activity + interaction_SlipTwin, & !< slip resistance from twin activity + interaction_TwinSlip, & !< twin resistance from slip activity + interaction_TwinTwin !< twin resistance from twin activity + end type + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type, private :: tPhenopowerlawState real(pReal), pointer, dimension(:,:) :: & s_slip, & @@ -180,7 +192,8 @@ subroutine plastic_phenopowerlaw_init(fileUnit) startIndex, endIndex character(len=65536) :: & tag = '', & - line = '' + line = '', & + outputtag = '' real(pReal), dimension(:), allocatable :: tempPerSlip write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' @@ -200,29 +213,19 @@ subroutine plastic_phenopowerlaw_init(fileUnit) allocate(plastic_phenopowerlaw_output(maxval(phase_Noutput),maxNinstance)) plastic_phenopowerlaw_output = '' allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) + + allocate(param(maxNinstance)) ! one container of parameters per instance + + allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_Ntrans(lattice_maxNtransFamily,maxNinstance),source=0_pInt) allocate(plastic_phenopowerlaw_totalNslip(maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_totalNtwin(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_totalNtrans(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_gdot0_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_n_slip(maxNinstance), source=0.0_pReal) allocate(plastic_phenopowerlaw_tau0_slip(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) allocate(plastic_phenopowerlaw_tausat_slip(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) allocate(plastic_phenopowerlaw_H_int(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_phenopowerlaw_gdot0_twin(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_n_twin(maxNinstance), source=0.0_pReal) allocate(plastic_phenopowerlaw_tau0_twin(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_spr(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinB(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinC(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinD(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinE(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_h0_SlipSlip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_h0_TwinSlip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_h0_TwinTwin(maxNinstance), source=0.0_pReal) allocate(plastic_phenopowerlaw_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance), & source=0.0_pReal) allocate(plastic_phenopowerlaw_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance), & @@ -231,17 +234,8 @@ subroutine plastic_phenopowerlaw_init(fileUnit) source=0.0_pReal) allocate(plastic_phenopowerlaw_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance), & source=0.0_pReal) - allocate(plastic_phenopowerlaw_a_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolResistance(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolShear(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolTwinfrac(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolTransfrac(maxNinstance), source=0.0_pReal) allocate(plastic_phenopowerlaw_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), & source=0.0_pReal) - allocate(plastic_phenopowerlaw_Cnuc(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_Cdwp(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_Cgro(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_deltaG(maxNinstance), source=0.0_pReal) rewind(fileUnit) phase = 0_pInt @@ -261,7 +255,6 @@ subroutine plastic_phenopowerlaw_init(fileUnit) if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase - Nchunks_TransFamilies = count(lattice_NtransSystem(:,phase) > 0_pInt) ! maximum number of trans families according to lattice type of current phase Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) @@ -278,58 +271,43 @@ subroutine plastic_phenopowerlaw_init(fileUnit) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') + outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt ! assume valid output + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = outputtag ! assume valid output select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('resistance_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulatedshear_slip','accumulated_shear_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shearrate_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolvedstress_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('totalshear') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalshear_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resistance_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulatedshear_twin','accumulated_shear_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shearrate_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolvedstress_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('totalvolfrac_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalvolfrac_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case default + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) - 1_pInt ! correct for invalid end select !-------------------------------------------------------------------------------------------------- @@ -374,17 +352,6 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plastic_phenopowerlaw_tau0_twin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo !-------------------------------------------------------------------------------------------------- -! parameters depending on number of transformation families - case ('ntrans') - if (chunkPos(1) < Nchunks_TransFamilies + 1_pInt) & - call IO_warning(53_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (chunkPos(1) > Nchunks_TransFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_TransFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_TransFamilies - plastic_phenopowerlaw_Ntrans(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo -!-------------------------------------------------------------------------------------------------- ! parameters depending on number of interactions case ('interaction_slipslip') if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & @@ -416,50 +383,41 @@ subroutine plastic_phenopowerlaw_init(fileUnit) do j = 1_pInt,Nchunks_nonSchmid plastic_phenopowerlaw_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip/twin systems case ('gdot0_slip') - plastic_phenopowerlaw_gdot0_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%gdot0_slip = IO_floatValue(line,chunkPos,2_pInt) case ('n_slip') - plastic_phenopowerlaw_n_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%n_slip = IO_floatValue(line,chunkPos,2_pInt) case ('a_slip', 'w0_slip') - plastic_phenopowerlaw_a_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%a_slip = IO_floatValue(line,chunkPos,2_pInt) case ('gdot0_twin') - plastic_phenopowerlaw_gdot0_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%gdot0_twin = IO_floatValue(line,chunkPos,2_pInt) case ('n_twin') - plastic_phenopowerlaw_n_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%n_twin = IO_floatValue(line,chunkPos,2_pInt) case ('s_pr') - plastic_phenopowerlaw_spr(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%spr = IO_floatValue(line,chunkPos,2_pInt) case ('twin_b') - plastic_phenopowerlaw_twinB(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%twinB = IO_floatValue(line,chunkPos,2_pInt) case ('twin_c') - plastic_phenopowerlaw_twinC(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%twinC = IO_floatValue(line,chunkPos,2_pInt) case ('twin_d') - plastic_phenopowerlaw_twinD(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%twinD = IO_floatValue(line,chunkPos,2_pInt) case ('twin_e') - plastic_phenopowerlaw_twinE(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%twinE = IO_floatValue(line,chunkPos,2_pInt) case ('h0_slipslip') - plastic_phenopowerlaw_h0_SlipSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%h0_SlipSlip = IO_floatValue(line,chunkPos,2_pInt) case ('h0_twinslip') - plastic_phenopowerlaw_h0_TwinSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%h0_TwinSlip = IO_floatValue(line,chunkPos,2_pInt) case ('h0_twintwin') - plastic_phenopowerlaw_h0_TwinTwin(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%h0_TwinTwin = IO_floatValue(line,chunkPos,2_pInt) case ('atol_resistance') - plastic_phenopowerlaw_aTolResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%aTolResistance = IO_floatValue(line,chunkPos,2_pInt) case ('atol_shear') - plastic_phenopowerlaw_aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%aTolShear = IO_floatValue(line,chunkPos,2_pInt) case ('atol_twinfrac') - plastic_phenopowerlaw_aTolTwinfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_transfrac') - plastic_phenopowerlaw_aTolTransfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cnuc') - plastic_phenopowerlaw_Cnuc(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cdwp') - plastic_phenopowerlaw_Cdwp(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cgro') - plastic_phenopowerlaw_Cgro(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('deltag') - plastic_phenopowerlaw_deltaG(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%aTolTwinfrac = IO_floatValue(line,chunkPos,2_pInt) case default end select @@ -477,37 +435,34 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plastic_phenopowerlaw_Ntwin(:,instance)) plastic_phenopowerlaw_totalNslip(instance) = sum(plastic_phenopowerlaw_Nslip(:,instance)) ! how many slip systems altogether plastic_phenopowerlaw_totalNtwin(instance) = sum(plastic_phenopowerlaw_Ntwin(:,instance)) ! how many twin systems altogether - plastic_phenopowerlaw_totalNtrans(instance) = sum(plastic_phenopowerlaw_Ntrans(:,instance)) ! how many trans systems altogether if (any(plastic_phenopowerlaw_tau0_slip(:,instance) < 0.0_pReal .and. & plastic_phenopowerlaw_Nslip(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (plastic_phenopowerlaw_gdot0_slip(instance) <= 0.0_pReal) & + if (param(instance)%gdot0_slip <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (plastic_phenopowerlaw_n_slip(instance) <= 0.0_pReal) & + if (param(instance)%n_slip <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') if (any(plastic_phenopowerlaw_tausat_slip(:,instance) <= 0.0_pReal .and. & plastic_phenopowerlaw_Nslip(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(dEq0(plastic_phenopowerlaw_a_slip(instance)) .and. plastic_phenopowerlaw_Nslip(:,instance) > 0)) & + if (any(dEq0(param(instance)%a_slip) .and. plastic_phenopowerlaw_Nslip(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') if (any(plastic_phenopowerlaw_tau0_twin(:,instance) < 0.0_pReal .and. & plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( plastic_phenopowerlaw_gdot0_twin(instance) <= 0.0_pReal .and. & + if ( param(instance)%gdot0_twin <= 0.0_pReal .and. & any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( plastic_phenopowerlaw_n_twin(instance) <= 0.0_pReal .and. & + if ( param(instance)%n_twin <= 0.0_pReal .and. & any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (plastic_phenopowerlaw_aTolResistance(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolResistance(instance) = 1.0_pReal ! default absolute tolerance 1 Pa - if (plastic_phenopowerlaw_aTolShear(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolShear(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (plastic_phenopowerlaw_aTolTwinfrac(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolTwinfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (plastic_phenopowerlaw_aTolTransfrac(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolTransfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + if (param(instance)%aTolResistance <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolResistance ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (param(instance)%aTolShear <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolShear ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (param(instance)%aTolTwinfrac <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') endif myPhase enddo sanityChecks @@ -578,7 +533,7 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plasticState(phase)%sizePostResults = plastic_phenopowerlaw_sizePostResults(instance) plasticState(phase)%nSlip =plastic_phenopowerlaw_totalNslip(instance) plasticState(phase)%nTwin =plastic_phenopowerlaw_totalNtwin(instance) - plasticState(phase)%nTrans=plastic_phenopowerlaw_totalNtrans(instance) + plasticState(phase)%nTrans=0_pInt allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) @@ -751,19 +706,18 @@ subroutine plastic_phenopowerlaw_aTolState(ph,instance) plasticState(ph)%aTolState(1:plastic_phenopowerlaw_totalNslip(instance)+ & plastic_phenopowerlaw_totalNtwin(instance)) = & - plastic_phenopowerlaw_aTolResistance(instance) + param(instance)%aTolResistance plasticState(ph)%aTolState(1+plastic_phenopowerlaw_totalNslip(instance)+ & plastic_phenopowerlaw_totalNtwin(instance)) = & - plastic_phenopowerlaw_aTolShear(instance) + param(instance)%aTolShear plasticState(ph)%aTolState(2+plastic_phenopowerlaw_totalNslip(instance)+ & plastic_phenopowerlaw_totalNtwin(instance)) = & - plastic_phenopowerlaw_aTolTwinFrac(instance) + param(instance)%aTolTwinFrac plasticState(ph)%aTolState(3+plastic_phenopowerlaw_totalNslip(instance)+ & plastic_phenopowerlaw_totalNtwin(instance): & 2+2*(plastic_phenopowerlaw_totalNslip(instance)+ & plastic_phenopowerlaw_totalNtwin(instance))) = & - plastic_phenopowerlaw_aTolShear(instance) - + param(instance)%aTolShear end subroutine plastic_phenopowerlaw_aTolState @@ -850,20 +804,20 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)*& lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo - gdot_slip_pos = 0.5_pReal*plastic_phenopowerlaw_gdot0_slip(instance)* & + gdot_slip_pos = 0.5_pReal*param(instance)%gdot0_slip* & ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of))) & - **plastic_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_pos) + **param(instance)%n_slip)*sign(1.0_pReal,tau_slip_pos) - gdot_slip_neg = 0.5_pReal*plastic_phenopowerlaw_gdot0_slip(instance)* & + gdot_slip_neg = 0.5_pReal*param(instance)%gdot0_slip* & ((abs(tau_slip_neg)/(state(instance)%s_slip(j,of))) & - **plastic_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_neg) + **param(instance)%n_slip)*sign(1.0_pReal,tau_slip_neg) Lp = Lp + (1.0_pReal-state(instance)%sumF(of))*& ! 1-F (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! Calculation of the tangent of Lp if (dNeq0(gdot_slip_pos)) then - dgdot_dtauslip_pos = gdot_slip_pos*plastic_phenopowerlaw_n_slip(instance)/tau_slip_pos + dgdot_dtauslip_pos = gdot_slip_pos*param(instance)%n_slip/tau_slip_pos forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dgdot_dtauslip_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & @@ -871,7 +825,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, endif if (dNeq0(gdot_slip_neg)) then - dgdot_dtauslip_neg = gdot_slip_neg*plastic_phenopowerlaw_n_slip(instance)/tau_slip_neg + dgdot_dtauslip_neg = gdot_slip_neg*param(instance)%n_slip/tau_slip_neg forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dgdot_dtauslip_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & @@ -891,14 +845,14 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, ! Calculation of Lp tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) gdot_twin = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F - plastic_phenopowerlaw_gdot0_twin(instance)*& + param(instance)%gdot0_twin*& (abs(tau_twin)/state(instance)%s_twin(j,of))**& - plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) ! Calculation of the tangent of Lp if (dNeq0(gdot_twin)) then - dgdot_dtautwin = gdot_twin*plastic_phenopowerlaw_n_twin(instance)/tau_twin + dgdot_dtautwin = gdot_twin*param(instance)%n_twin/tau_twin forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dgdot_dtautwin*lattice_Stwin(k,l,index_myFamily+i,ph)* & @@ -971,17 +925,17 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices - c_SlipSlip = plastic_phenopowerlaw_h0_SlipSlip(instance)*& - (1.0_pReal + plastic_phenopowerlaw_twinC(instance)*plasticState(ph)%state(index_F,of)**& - plastic_phenopowerlaw_twinB(instance)) - c_TwinSlip = plastic_phenopowerlaw_h0_TwinSlip(instance)*& - plasticState(ph)%state(index_Gamma,of)**plastic_phenopowerlaw_twinE(instance) - c_TwinTwin = plastic_phenopowerlaw_h0_TwinTwin(instance)*& - plasticState(ph)%state(index_F,of)**plastic_phenopowerlaw_twinD(instance) + c_SlipSlip = param(instance)%h0_slipslip*& + (1.0_pReal + param(instance)%twinC*plasticState(ph)%state(index_F,of)**& + param(instance)%twinB) + c_TwinSlip = param(instance)%h0_TwinSlip*& + plasticState(ph)%state(index_Gamma,of)**param(instance)%twinE + c_TwinTwin = param(instance)%h0_TwinTwin*& + plasticState(ph)%state(index_F,of)**param(instance)%twinD !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors and calculate dot gammas - ssat_offset = plastic_phenopowerlaw_spr(instance)*sqrt(plasticState(ph)%state(index_F,of)) + ssat_offset = param(instance)%spr*sqrt(plasticState(ph)%state(index_F,of)) j = 0_pInt slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family @@ -991,7 +945,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & - **plastic_phenopowerlaw_a_slip(instance)& + **param(instance)%a_slip& *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) right_TwinSlip(j) = 1.0_pReal ! no system-dependent part @@ -1006,10 +960,10 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems - gdot_slip(j) = plastic_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/(plasticState(ph)%state(j,of)))**plastic_phenopowerlaw_n_slip(instance) & + gdot_slip(j) = param(instance)%gdot0_slip*0.5_pReal* & + ((abs(tau_slip_pos)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**plastic_phenopowerlaw_n_slip(instance) & + +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -1030,9 +984,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ! Calculation of dot vol frac tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - plastic_phenopowerlaw_gdot0_twin(instance)*& + param(instance)%gdot0_twin*& (abs(tau_twin)/plasticState(ph)%state(nslip+j,of))**& - plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) enddo twinSystems1 enddo twinFamilies1 @@ -1153,10 +1107,10 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo - plastic_phenopowerlaw_postResults(c+j) = plastic_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**plastic_phenopowerlaw_n_slip(instance) & + plastic_phenopowerlaw_postResults(c+j) = param(instance)%gdot0_slip*0.5_pReal* & + ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**plastic_phenopowerlaw_n_slip(instance) & + +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -1196,9 +1150,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) j = j + 1_pInt tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - plastic_phenopowerlaw_gdot0_twin(instance)*& + param(instance)%gdot0_twin*& (abs(tau)/plasticState(ph)%state(j+nSlip,of))**& - plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau)) + param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) enddo twinSystems1 enddo twinFamilies1 c = c + nTwin From 81cab02d7ab98b36fdc43b3c9b339aa25566a7a5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 25 Apr 2018 19:41:18 +0200 Subject: [PATCH 002/208] simplified reading in and initialization init of absolute tolerances and state0 done on the fly reading in array type parameters in the param structure : --- src/math.f90 | 3 +- src/plastic_phenopowerlaw.f90 | 527 ++++++++++++++-------------------- 2 files changed, 225 insertions(+), 305 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 7e35ca390..4354354f7 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -159,7 +159,8 @@ module math math_rotate_forward33, & math_rotate_backward33, & math_rotate_forward3333, & - math_limit + math_limit, & + math_expand private :: & halton, & halton_memory, & diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 368ce8bd5..4b41f9ad2 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -22,33 +22,19 @@ module plastic_phenopowerlaw integer(pInt), dimension(:), allocatable, target, public :: & plastic_phenopowerlaw_Noutput !< number of outputs per instance of this constitution - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_phenopowerlaw_totalNslip, & !< no. of slip system used in simulation - plastic_phenopowerlaw_totalNtwin !< no. of twin system used in simulation + integer(pInt), dimension(:), allocatable, private :: & + totalNslip, & !< no. of slip system used in simulation + totalNtwin !< no. of twin system used in simulation - integer(pInt), dimension(:,:), allocatable, private :: & - plastic_phenopowerlaw_Nslip, & !< active number of slip systems per family (input parameter, per family) - plastic_phenopowerlaw_Ntwin !< active number of twin systems per family (input parameter, per family) + real(pReal), dimension(:,:,:), allocatable, private :: & + + interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) + interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) + interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) + interaction_TwinTwin !< interaction factors twin - twin (input parameter) - real(pReal), dimension(:,:), allocatable, private :: & - plastic_phenopowerlaw_tau0_slip, & !< initial critical shear stress for slip (input parameter, per family) - plastic_phenopowerlaw_tau0_twin, & !< initial critical shear stress for twin (input parameter, per family) - plastic_phenopowerlaw_tausat_slip, & !< maximum critical shear stress for slip (input parameter, per family) - plastic_phenopowerlaw_H_int, & !< per family hardening activity(input parameter(optional), per family) - plastic_phenopowerlaw_nonSchmidCoeff, & - - plastic_phenopowerlaw_interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) - plastic_phenopowerlaw_interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) - plastic_phenopowerlaw_interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) - plastic_phenopowerlaw_interaction_TwinTwin !< interaction factors twin - twin (input parameter) - - real(pReal), dimension(:,:,:), allocatable, private :: & - plastic_phenopowerlaw_hardeningMatrix_SlipSlip, & - plastic_phenopowerlaw_hardeningMatrix_SlipTwin, & - plastic_phenopowerlaw_hardeningMatrix_TwinSlip, & - plastic_phenopowerlaw_hardeningMatrix_TwinTwin enum, bind(c) enumerator :: undefined_ID, & @@ -114,18 +100,13 @@ module plastic_phenopowerlaw type(tPhenopowerlawState), allocatable, dimension(:), private :: & dotState, & - state, & - state0 + state public :: & plastic_phenopowerlaw_init, & plastic_phenopowerlaw_LpAndItsTangent, & plastic_phenopowerlaw_dotState, & plastic_phenopowerlaw_postResults - private :: & - plastic_phenopowerlaw_aTolState, & - plastic_phenopowerlaw_stateInit - contains @@ -148,7 +129,8 @@ subroutine plastic_phenopowerlaw_init(fileUnit) debug_levelBasic use math, only: & math_Mandel3333to66, & - math_Voigt66to3333 + math_Voigt66to3333, & + math_expand use IO, only: & IO_read, & IO_lc, & @@ -191,8 +173,10 @@ subroutine plastic_phenopowerlaw_init(fileUnit) mySize=0_pInt,sizeState,sizeDotState, sizeDeltaState, & startIndex, endIndex character(len=65536) :: & - tag = '', & - line = '', & + tag = '', & + line = '', & + extmsg = '' + character(len=64) :: & outputtag = '' real(pReal), dimension(:), allocatable :: tempPerSlip @@ -214,28 +198,11 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plastic_phenopowerlaw_output = '' allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) - allocate(param(maxNinstance)) ! one container of parameters per instance - - allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_totalNslip(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_totalNtwin(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_tau0_slip(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_phenopowerlaw_tausat_slip(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_phenopowerlaw_H_int(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_phenopowerlaw_tau0_twin(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_TwinSlip(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), & - source=0.0_pReal) + + allocate(totalNslip(maxNinstance), source=0_pInt) + allocate(totalNtwin(maxNinstance), source=0_pInt) + allocate(param(maxNinstance)) ! one container of parameters per instance rewind(fileUnit) phase = 0_pInt @@ -253,6 +220,7 @@ subroutine plastic_phenopowerlaw_init(fileUnit) if (IO_getTag(line,'[',']') /= '') then ! next phase phase = phase + 1_pInt ! advance phase section counter if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then + instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) @@ -261,15 +229,24 @@ subroutine plastic_phenopowerlaw_init(fileUnit) Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) Nchunks_nonSchmid = lattice_NnonSchmid(phase) if(allocated(tempPerSlip)) deallocate(tempPerSlip) + !allocate(param(instance)%H_int,source=tempPerSlip) gfortran 5 does not support this + allocate(param(instance)%H_int(Nchunks_SlipFamilies),source=0.0_pReal) + allocate(param(instance)%interaction_SlipSlip(Nchunks_SlipSlip),source=0.0_pReal) + allocate(param(instance)%interaction_SlipTwin(Nchunks_SlipTwin),source=0.0_pReal) + allocate(param(instance)%interaction_TwinSlip(Nchunks_TwinSlip),source=0.0_pReal) + allocate(param(instance)%interaction_TwinTwin(Nchunks_TwinTwin),source=0.0_pReal) + allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid),source=0.0_pReal) + allocate(tempPerSlip(Nchunks_SlipFamilies)) endif cycle ! skip to next line endif if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran - instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) + select case(tag) + case ('(output)') outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt ! assume valid output @@ -310,80 +287,87 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) - 1_pInt ! correct for invalid end select + !-------------------------------------------------------------------------------------------------- ! parameters depending on number of slip families case ('nslip') - if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) + if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) call IO_warning(50_pInt,ext_msg=extmsg) + if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) + allocate(param(instance)%Nslip(Nchunks_SlipFamilies),source=-1_pInt) do j = 1_pInt, Nchunks_SlipFamilies - plastic_phenopowerlaw_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + param(instance)%Nslip(j) = min(IO_intValue(line,chunkPos,1_pInt+j), & + lattice_NslipSystem(j,phase)) ! limit active slip systems per family to min of available and requested enddo - case ('tausat_slip','tau0_slip','H_int') + totalNslip(instance) = sum(param(instance)%Nslip) ! how many slip systems altogether + + case ('tausat_slip','tau0_slip','h_int') tempPerSlip = 0.0_pReal do j = 1_pInt, Nchunks_SlipFamilies - if (plastic_phenopowerlaw_Nslip(j,instance) > 0_pInt) & + if (param(instance)%Nslip(j) > 0_pInt) & tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo - select case(tag) + select case(tag) ! here, all arrays are allocated automatically case ('tausat_slip') - plastic_phenopowerlaw_tausat_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + param(instance)%tausat_slip = tempPerSlip case ('tau0_slip') - plastic_phenopowerlaw_tau0_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('H_int') - plastic_phenopowerlaw_H_int(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + param(instance)%tau0_slip = tempPerSlip + case ('h_int') + param(instance)%H_int = tempPerSlip end select + !-------------------------------------------------------------------------------------------------- ! parameters depending on number of twin families case ('ntwin') - if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & - call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) call IO_warning(51_pInt,ext_msg=extmsg) + if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) Nchunks_TwinFamilies = chunkPos(1) - 1_pInt + allocate(param(instance)%Ntwin(Nchunks_TwinFamilies),source=-1_pInt) do j = 1_pInt, Nchunks_TwinFamilies - plastic_phenopowerlaw_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + param(instance)%Ntwin(j) = min(IO_intValue(line,chunkPos,1_pInt+j), & + lattice_NtwinSystem(j,phase)) ! limit active twin systems per family to min of available and requested enddo + totalNtwin(instance) = sum(param(instance)%Ntwin) ! how many twin systems altogether + case ('tau0_twin') + allocate(param(instance)%tau0_twin(Nchunks_TwinFamilies),source=0.0_pReal) do j = 1_pInt, Nchunks_TwinFamilies - if (plastic_phenopowerlaw_Ntwin(j,instance) > 0_pInt) & - plastic_phenopowerlaw_tau0_twin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + if (param(instance)%Ntwin(j) > 0_pInt) & + param(instance)%tau0_twin(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + !-------------------------------------------------------------------------------------------------- ! parameters depending on number of interactions case ('interaction_slipslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) call IO_warning(52_pInt,ext_msg=extmsg) do j = 1_pInt, Nchunks_SlipSlip - plastic_phenopowerlaw_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + param(instance)%interaction_SlipSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + case ('interaction_sliptwin') - if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) call IO_warning(52_pInt,ext_msg=extmsg) do j = 1_pInt, Nchunks_SlipTwin - plastic_phenopowerlaw_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + param(instance)%interaction_SlipTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + case ('interaction_twinslip') - if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) call IO_warning(52_pInt,ext_msg=extmsg) do j = 1_pInt, Nchunks_TwinSlip - plastic_phenopowerlaw_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + param(instance)%interaction_TwinSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + case ('interaction_twintwin') - if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) call IO_warning(52_pInt,ext_msg=extmsg) do j = 1_pInt, Nchunks_TwinTwin - plastic_phenopowerlaw_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + param(instance)%interaction_TwinTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + case ('nonschmid_coefficients') - if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) call IO_warning(52_pInt,ext_msg=extmsg) do j = 1_pInt,Nchunks_nonSchmid - plastic_phenopowerlaw_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + param(instance)%nonSchmidCoeff(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo - + !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip/twin systems case ('gdot0_slip') @@ -427,36 +411,35 @@ subroutine plastic_phenopowerlaw_init(fileUnit) sanityChecks: do phase = 1_pInt, size(phase_plasticity) myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then instance = phase_plasticityInstance(phase) - plastic_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,instance) = & - min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active slip systems per family to min of available and requested - plastic_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,instance)) - plastic_phenopowerlaw_Ntwin(1:lattice_maxNtwinFamily,instance) = & - min(lattice_NtwinSystem(1:lattice_maxNtwinFamily,phase),& ! limit active twin systems per family to min of available and requested - plastic_phenopowerlaw_Ntwin(:,instance)) - plastic_phenopowerlaw_totalNslip(instance) = sum(plastic_phenopowerlaw_Nslip(:,instance)) ! how many slip systems altogether - plastic_phenopowerlaw_totalNtwin(instance) = sum(plastic_phenopowerlaw_Ntwin(:,instance)) ! how many twin systems altogether + totalNslip(instance) = sum(param(instance)%Nslip) ! how many slip systems altogether. ToDo: ok for unallocated Nslip + totalNtwin(instance) = sum(param(instance)%Ntwin) ! how many twin systems altogether. ToDo: ok for unallocated Ntwin + slipActive: if (allocated(param(instance)%Nslip)) then + if (any(param(instance)%tau0_slip < 0.0_pReal .and. & + param(instance)%Nslip(:) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (param(instance)%gdot0_slip <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (param(instance)%n_slip <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(param(instance)%tausat_slip <= 0.0_pReal .and. & + param(instance)%Nslip(:) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(dEq0(param(instance)%a_slip) .and. param(instance)%Nslip(:) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + endif slipActive + + twinActive: if (allocated(param(instance)%Ntwin)) then + ! if (any(param(instance)%tau0_twin < 0.0_pReal .and. & + ! param(instance)%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + ! if ( param(instance)%gdot0_twin <= 0.0_pReal .and. & + ! any(param(instance)%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + ! if ( param(instance)%n_twin <= 0.0_pReal .and. & + ! any(param(instance)%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + endif twinActive - if (any(plastic_phenopowerlaw_tau0_slip(:,instance) < 0.0_pReal .and. & - plastic_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%gdot0_slip <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%n_slip <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(plastic_phenopowerlaw_tausat_slip(:,instance) <= 0.0_pReal .and. & - plastic_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(dEq0(param(instance)%a_slip) .and. plastic_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(plastic_phenopowerlaw_tau0_twin(:,instance) < 0.0_pReal .and. & - plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( param(instance)%gdot0_twin <= 0.0_pReal .and. & - any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( param(instance)%n_twin <= 0.0_pReal .and. & - any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') if (param(instance)%aTolResistance <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='aTolResistance ('//PLASTICITY_PHENOPOWERLAW_label//')') if (param(instance)%aTolShear <= 0.0_pReal) & @@ -465,26 +448,21 @@ subroutine plastic_phenopowerlaw_init(fileUnit) call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') endif myPhase enddo sanityChecks + -!-------------------------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------------------------- ! allocation of variables whose size depends on the total number of active slip systems - allocate(plastic_phenopowerlaw_hardeningMatrix_SlipSlip(maxval(plastic_phenopowerlaw_totalNslip),& ! slip resistance from slip activity - maxval(plastic_phenopowerlaw_totalNslip),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_hardeningMatrix_SlipTwin(maxval(plastic_phenopowerlaw_totalNslip),& ! slip resistance from twin activity - maxval(plastic_phenopowerlaw_totalNtwin),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_hardeningMatrix_TwinSlip(maxval(plastic_phenopowerlaw_totalNtwin),& ! twin resistance from slip activity - maxval(plastic_phenopowerlaw_totalNslip),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_hardeningMatrix_TwinTwin(maxval(plastic_phenopowerlaw_totalNtwin),& ! twin resistance from twin activity - maxval(plastic_phenopowerlaw_totalNtwin),& - maxNinstance), source=0.0_pReal) + allocate(interaction_SlipSlip(maxval(totalNslip),maxval(totalNslip),maxNinstance), source=0.0_pReal) + allocate(interaction_SlipTwin(maxval(totalNslip),maxval(totalNtwin),maxNinstance), source=0.0_pReal) + allocate(interaction_TwinSlip(maxval(totalNtwin),maxval(totalNslip),maxNinstance), source=0.0_pReal) + allocate(interaction_TwinTwin(maxval(totalNtwin),maxval(totalNtwin),maxNinstance), source=0.0_pReal) + + allocate(state(maxNinstance)) - allocate(state0(maxNinstance)) allocate(dotState(maxNinstance)) initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop through all phases in material.config + myPhase2: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then ! only consider my phase NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase instance = phase_plasticityInstance(phase) ! which instance of my phase @@ -498,13 +476,13 @@ subroutine plastic_phenopowerlaw_init(fileUnit) accumulatedshear_slip_ID, & resolvedstress_slip_ID & ) - mySize = plastic_phenopowerlaw_totalNslip(instance) + mySize = totalNslip(instance) case(resistance_twin_ID, & shearrate_twin_ID, & accumulatedshear_twin_ID, & resolvedstress_twin_ID & ) - mySize = plastic_phenopowerlaw_totalNtwin(instance) + mySize = totalNtwin(instance) case(totalshear_ID, & totalvolfrac_twin_ID & ) @@ -519,11 +497,11 @@ subroutine plastic_phenopowerlaw_init(fileUnit) enddo outputsLoop !-------------------------------------------------------------------------------------------------- ! allocate state arrays - sizeState = plastic_phenopowerlaw_totalNslip(instance) & ! s_slip - + plastic_phenopowerlaw_totalNtwin(instance) & ! s_twin + sizeState = totalNslip(instance) & ! s_slip + + totalNtwin(instance) & ! s_twin + 2_pInt & ! sum(gamma) + sum(f) - + plastic_phenopowerlaw_totalNslip(instance) & ! accshear_slip - + plastic_phenopowerlaw_totalNtwin(instance) ! accshear_twin + + totalNslip(instance) & ! accshear_slip + + totalNtwin(instance) ! accshear_twin sizeDotState = sizeState sizeDeltaState = 0_pInt @@ -531,8 +509,8 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plasticState(phase)%sizeDotState = sizeDotState plasticState(phase)%sizeDeltaState = sizeDeltaState plasticState(phase)%sizePostResults = plastic_phenopowerlaw_sizePostResults(instance) - plasticState(phase)%nSlip =plastic_phenopowerlaw_totalNslip(instance) - plasticState(phase)%nTwin =plastic_phenopowerlaw_totalNtwin(instance) + plasticState(phase)%nSlip =totalNslip(instance) + plasticState(phase)%nTwin =totalNtwin(instance) plasticState(phase)%nTrans=0_pInt allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) @@ -556,171 +534,112 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plasticState(phase)%accumulatedSlip => & plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X - index_myFamily = sum(plastic_phenopowerlaw_Nslip(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) ! loop over (active) systems in my family (slip) - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_phenopowerlaw_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) - plastic_phenopowerlaw_hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_SlipSlip(lattice_interactionSlipSlip( & +!-------------------------------------------------------------------------------------------------- +! calculate hardening matrices and extend intitial values (per family -> per system) + mySlipFamilies: do f = 1_pInt,size(param(instance)%Nslip,1) ! >>> interaction slip -- X + index_myFamily = sum(param(instance)%Nslip(1:f-1_pInt)) + + mySlipSystems: do j = 1_pInt,param(instance)%Nslip(f) + otherSlipFamilies: do o = 1_pInt,size(param(instance)%Nslip,1) + index_otherFamily = sum(param(instance)%Nslip(1:o-1_pInt)) + otherSlipSystems: do k = 1_pInt,param(instance)%Nslip(o) + interaction_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & + param(instance)%interaction_SlipSlip(lattice_interactionSlipSlip( & sum(lattice_NslipSystem(1:f-1,phase))+j, & sum(lattice_NslipSystem(1:o-1,phase))+k, & - phase), instance ) - enddo; enddo + phase)) + enddo otherSlipSystems; enddo otherSlipFamilies - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(plastic_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - plastic_phenopowerlaw_hardeningMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_SlipTwin(lattice_interactionSlipTwin( & + twinFamilies: do o = 1_pInt,size(param(instance)%Ntwin,1) + index_otherFamily = sum(param(instance)%Ntwin(1:o-1_pInt)) + twinSystems: do k = 1_pInt,param(instance)%Ntwin(o) + interaction_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & + param(instance)%interaction_SlipTwin(lattice_interactionSlipTwin( & sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & - phase), instance ) - enddo; enddo + phase)) + enddo twinSystems; enddo twinFamilies + enddo mySlipSystems + enddo mySlipFamilies - enddo; enddo - - do f = 1_pInt,lattice_maxNtwinFamily ! >>> interaction twin -- X - index_myFamily = sum(plastic_phenopowerlaw_Ntwin(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) ! loop over (active) systems in my family (twin) - - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_phenopowerlaw_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) - plastic_phenopowerlaw_hardeningMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_TwinSlip(lattice_interactionTwinSlip( & + myTwinFamilies: do f = 1_pInt,size(param(instance)%Ntwin,1) ! >>> interaction twin -- X + index_myFamily = sum(param(instance)%Ntwin(1:f-1_pInt)) + myTwinSystems: do j = 1_pInt,param(instance)%Ntwin(f) + slipFamilies: do o = 1_pInt,size(param(instance)%Nslip,1) + index_otherFamily = sum(param(instance)%Nslip(1:o-1_pInt)) + slipSystems: do k = 1_pInt,param(instance)%Nslip(o) + interaction_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & + param(instance)%interaction_TwinSlip(lattice_interactionTwinSlip( & sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & - phase), instance ) - enddo; enddo + phase)) + enddo slipSystems; enddo slipFamilies - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(plastic_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - plastic_phenopowerlaw_hardeningMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_TwinTwin(lattice_interactionTwinTwin( & + otherTwinFamilies: do o = 1_pInt,size(param(instance)%Ntwin,1) + index_otherFamily = sum(param(instance)%Ntwin(1:o-1_pInt)) + otherTwinSystems: do k = 1_pInt,param(instance)%Ntwin(o) + interaction_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & + param(instance)%interaction_TwinTwin(lattice_interactionTwinTwin( & sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & - phase), instance ) - enddo; enddo + phase)) + enddo otherTwinSystems; enddo otherTwinFamilies + enddo myTwinSystems + enddo myTwinFamilies - enddo; enddo +!-------------------------------------------------------------------------------------------------- +! locally defined state aliases and initialization of state0 and aTolState startIndex = 1_pInt - endIndex = plastic_phenopowerlaw_totalNslip(instance) + endIndex = totalNslip(instance) state (instance)%s_slip=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%s_slip=>plasticState(phase)%state0 (startIndex:endIndex,:) dotState(instance)%s_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(phase)%state0(startIndex:endIndex,:) = & + spread(math_expand(param(instance)%tau0_slip, param(instance)%Nslip), 2, NipcMyPhase) + + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolResistance startIndex = endIndex + 1_pInt - endIndex = endIndex + plastic_phenopowerlaw_totalNtwin(instance) + endIndex = endIndex + totalNtwin(instance) state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%s_twin=>plasticState(phase)%state0 (startIndex:endIndex,:) dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(phase)%state0(startIndex:endIndex,:) = & + spread(param(instance)%tau0_twin(1:totalNtwin(instance)),2,NipcMyPhase) + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumGamma=>plasticState(phase)%state (startIndex,:) - state0 (instance)%sumGamma=>plasticState(phase)%state0 (startIndex,:) dotState(instance)%sumGamma=>plasticState(phase)%dotState(startIndex,:) + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumF=>plasticState(phase)%state (startIndex,:) - state0 (instance)%sumF=>plasticState(phase)%state0 (startIndex,:) dotState(instance)%sumF=>plasticState(phase)%dotState(startIndex,:) + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolTwinFrac startIndex = endIndex + 1_pInt - endIndex = endIndex +plastic_phenopowerlaw_totalNslip(instance) + endIndex = endIndex + totalNslip(instance) state (instance)%accshear_slip=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%accshear_slip=>plasticState(phase)%state0 (startIndex:endIndex,:) dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear + ! global alias + plasticState(phase)%slipRate =>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(phase)%accumulatedSlip =>plasticState(phase)%state(startIndex:endIndex,:) startIndex = endIndex + 1_pInt - endIndex = endIndex +plastic_phenopowerlaw_totalNtwin(instance) + endIndex = endIndex + totalNtwin(instance) state (instance)%accshear_twin=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%accshear_twin=>plasticState(phase)%state0 (startIndex:endIndex,:) dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear - - call plastic_phenopowerlaw_stateInit(phase,instance) - call plastic_phenopowerlaw_aTolState(phase,instance) endif myPhase2 enddo initializeInstances + end subroutine plastic_phenopowerlaw_init -!-------------------------------------------------------------------------------------------------- -!> @brief sets the initial microstructural state for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_stateInit(ph,instance) - use lattice, only: & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: & - instance, & !< number specifying the instance of the plasticity - ph - integer(pInt) :: & - i - real(pReal), dimension(plasticState(ph)%sizeState) :: & - tempState - - tempState = 0.0_pReal - do i = 1_pInt,lattice_maxNslipFamily - tempState(1+sum(plastic_phenopowerlaw_Nslip(1:i-1,instance)) : & - sum(plastic_phenopowerlaw_Nslip(1:i ,instance))) = & - plastic_phenopowerlaw_tau0_slip(i,instance) - enddo - - do i = 1_pInt,lattice_maxNtwinFamily - tempState(1+sum(plastic_phenopowerlaw_Nslip(:,instance))+& - sum(plastic_phenopowerlaw_Ntwin(1:i-1,instance)) : & - sum(plastic_phenopowerlaw_Nslip(:,instance))+& - sum(plastic_phenopowerlaw_Ntwin(1:i ,instance))) = & - plastic_phenopowerlaw_tau0_twin(i,instance) - enddo - - plasticState(ph)%state0(:,:) = spread(tempState, & ! spread single tempstate array - 2, & ! along dimension 2 - size(plasticState(ph)%state0(1,:))) ! number of copies (number of IPCs) - -end subroutine plastic_phenopowerlaw_stateInit - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_aTolState(ph,instance) - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: & - instance, & !< number specifying the instance of the plasticity - ph - - plasticState(ph)%aTolState(1:plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance)) = & - param(instance)%aTolResistance - plasticState(ph)%aTolState(1+plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance)) = & - param(instance)%aTolShear - plasticState(ph)%aTolState(2+plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance)) = & - param(instance)%aTolTwinFrac - plasticState(ph)%aTolState(3+plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance): & - 2+2*(plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance))) = & - param(instance)%aTolShear -end subroutine plastic_phenopowerlaw_aTolState - - !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- @@ -784,9 +703,9 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, !-------------------------------------------------------------------------------------------------- ! Slip part j = 0_pInt - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies: do f = 1_pInt,size(param(instance)%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems: do i = 1_pInt,param(instance)%Nslip(f) j = j+1_pInt ! Calculation of Lp @@ -795,13 +714,13 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_neg = tau_slip_neg + param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)*& + nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + param(instance)%nonSchmidCoeff(k)*& lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)*& + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + param(instance)%nonSchmidCoeff(k)*& lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo gdot_slip_pos = 0.5_pReal*param(instance)%gdot0_slip* & @@ -837,9 +756,9 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, !-------------------------------------------------------------------------------------------------- ! Twinning part j = 0_pInt - twinFamilies: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems: do i = 1_pInt,param(instance)%Ntwin(f) j = j+1_pInt ! Calculation of Lp @@ -905,17 +824,17 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ssat_offset, & tau_slip_pos,tau_slip_neg,tau_twin - real(pReal), dimension(plastic_phenopowerlaw_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip - real(pReal), dimension(plastic_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - nSlip = plastic_phenopowerlaw_totalNslip(instance) - nTwin = plastic_phenopowerlaw_totalNtwin(instance) + nSlip = totalNslip(instance) + nTwin = totalNtwin(instance) index_Gamma = nSlip + nTwin + 1_pInt index_F = nSlip + nTwin + 2_pInt @@ -937,17 +856,17 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ! calculate left and right vectors and calculate dot gammas ssat_offset = param(instance)%spr*sqrt(plasticState(ph)%state(index_F,of)) j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies1: do f =1_pInt,size(param(instance)%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems1: do i = 1_pInt,param(instance)%Nslip(f) j = j+1_pInt - left_SlipSlip(j) = 1.0_pReal + plastic_phenopowerlaw_H_int(f,instance) ! modified no system-dependent left part + left_SlipSlip(j) = 1.0_pReal + param(instance)%H_int(f) ! modified no system-dependent left part left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & + (param(instance)%tausat_slip(f)+ssat_offset)) & **param(instance)%a_slip& *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) + (param(instance)%tausat_slip(f)+ssat_offset)) right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- @@ -955,9 +874,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_neg = tau_slip_neg +param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems gdot_slip(j) = param(instance)%gdot0_slip*0.5_pReal* & @@ -971,9 +890,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) j = 0_pInt - twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies1: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems1: do i = 1_pInt,param(instance)%Ntwin(f) j = j+1_pInt left_TwinSlip(j) = 1.0_pReal ! no system-dependent left part left_TwinTwin(j) = 1.0_pReal ! no system-dependent left part @@ -993,14 +912,14 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above j = 0_pInt - slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily - slipSystems2: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipFamilies2: do f = 1_pInt,size(param(instance)%Nslip,1) + slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) j = j+1_pInt plasticState(ph)%dotState(j,of) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & - dot_product(plastic_phenopowerlaw_hardeningMatrix_SlipSlip(j,1:nSlip,instance), & + dot_product(interaction_SlipSlip(j,1:totalNslip(instance),instance), & right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(plastic_phenopowerlaw_hardeningMatrix_SlipTwin(j,1:nTwin,instance), & + dot_product(interaction_SlipTwin(j,1:totalNtwin(instance),instance), & right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor plasticState(ph)%dotState(index_Gamma,of) = plasticState(ph)%dotState(index_Gamma,of) + & abs(gdot_slip(j)) @@ -1009,16 +928,16 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) enddo slipFamilies2 j = 0_pInt - twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems2: do i = 1_pInt,param(instance)%Ntwin(f) j = j+1_pInt plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j c_TwinSlip * left_TwinSlip(j) * & - dot_product(plastic_phenopowerlaw_hardeningMatrix_TwinSlip(j,1:nSlip,instance), & + dot_product(interaction_TwinSlip(j,1:totalNslip(instance),instance), & right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * left_TwinTwin(j) * & - dot_product(plastic_phenopowerlaw_hardeningMatrix_TwinTwin(j,1:nTwin,instance), & + dot_product(interaction_TwinTwin(j,1:totalNtwin(instance),instance), & right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (plasticState(ph)%state(index_F,of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 plasticState(ph)%dotState(index_F,of) = plasticState(ph)%dotState(index_F,of) + & @@ -1071,8 +990,8 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - nSlip = plastic_phenopowerlaw_totalNslip(instance) - nTwin = plastic_phenopowerlaw_totalNtwin(instance) + nSlip = totalNslip(instance) + nTwin = totalNtwin(instance) index_Gamma = nSlip + nTwin + 1_pInt index_F = nSlip + nTwin + 2_pInt @@ -1095,16 +1014,16 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (shearrate_slip_ID) j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies1: do f = 1_pInt,size(param(instance)%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems1: do i = 1_pInt,param(instance)%Nslip(f) j = j + 1_pInt tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_pos = tau_slip_pos +param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_neg = tau_slip_neg +param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo plastic_phenopowerlaw_postResults(c+j) = param(instance)%gdot0_slip*0.5_pReal* & @@ -1118,9 +1037,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (resolvedstress_slip_ID) j = 0_pInt - slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems2: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) @@ -1144,9 +1063,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + nTwin case (shearrate_twin_ID) j = 0_pInt - twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies1: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems1: do i = 1_pInt,param(instance)%Ntwin(f) j = j + 1_pInt tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F @@ -1159,9 +1078,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (resolvedstress_twin_ID) j = 0_pInt - twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems2: do i = 1_pInt,param(instance)%Ntwin(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) From e3bd09d8e69a8d0efa9f7c4899e0af4396c14ae3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 26 Apr 2018 18:12:45 +0200 Subject: [PATCH 003/208] wrong initiatilization --- src/plastic_phenopowerlaw.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 4b41f9ad2..bcb87a25d 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -603,7 +603,7 @@ subroutine plastic_phenopowerlaw_init(fileUnit) state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%state0(startIndex:endIndex,:) = & - spread(param(instance)%tau0_twin(1:totalNtwin(instance)),2,NipcMyPhase) + spread(math_expand(param(instance)%tau0_twin, param(instance)%Ntwin), 2, NipcMyPhase) plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolResistance startIndex = endIndex + 1_pInt From d9548b455ebec08a93903a2b77313dcdcf23f781 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 26 Apr 2018 18:35:49 +0200 Subject: [PATCH 004/208] should loop over slip systems --- src/plastic_phenopowerlaw.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index bcb87a25d..82deea1c3 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -1037,7 +1037,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (resolvedstress_slip_ID) j = 0_pInt - slipFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) + slipFamilies2: do f = 1_pInt,size(param(instance)%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) j = j + 1_pInt From 423fcd6e0dcafa83ba879e6945f42d93759d6773 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Fri, 27 Apr 2018 19:53:54 +0200 Subject: [PATCH 005/208] using state pointer increases readability in dotState --- src/plastic_phenopowerlaw.f90 | 46 +++++++++++++++-------------------- 1 file changed, 19 insertions(+), 27 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 82deea1c3..042b80be3 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -816,8 +816,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) instance,ph, & nSlip,nTwin, & f,i,j,k, & - index_Gamma,index_F,index_myFamily, & - offset_accshear_slip,offset_accshear_twin, & + index_myfamily, & of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & @@ -833,28 +832,21 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - nSlip = totalNslip(instance) - nTwin = totalNtwin(instance) - - index_Gamma = nSlip + nTwin + 1_pInt - index_F = nSlip + nTwin + 2_pInt - offset_accshear_slip = nSlip + nTwin + 2_pInt - offset_accshear_twin = nSlip + nTwin + 2_pInt + nSlip plasticState(ph)%dotState(:,of) = 0.0_pReal !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices c_SlipSlip = param(instance)%h0_slipslip*& - (1.0_pReal + param(instance)%twinC*plasticState(ph)%state(index_F,of)**& + (1.0_pReal + param(instance)%twinC*state(instance)%sumF(of)**& param(instance)%twinB) c_TwinSlip = param(instance)%h0_TwinSlip*& - plasticState(ph)%state(index_Gamma,of)**param(instance)%twinE + state(instance)%sumGamma(of)**param(instance)%twinE c_TwinTwin = param(instance)%h0_TwinTwin*& - plasticState(ph)%state(index_F,of)**param(instance)%twinD + state(instance)%sumF(of)**param(instance)%twinD !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors and calculate dot gammas - ssat_offset = param(instance)%spr*sqrt(plasticState(ph)%state(index_F,of)) + ssat_offset = param(instance)%spr*sqrt(state(instance)%sumF(of)) j = 0_pInt slipFamilies1: do f =1_pInt,size(param(instance)%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family @@ -862,11 +854,11 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) j = j+1_pInt left_SlipSlip(j) = 1.0_pReal + param(instance)%H_int(f) ! modified no system-dependent left part left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part - right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & + right_SlipSlip(j) = abs(1.0_pReal-state(instance)%s_slip(j,of) / & (param(instance)%tausat_slip(f)+ssat_offset)) & **param(instance)%a_slip& - *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & - (param(instance)%tausat_slip(f)+ssat_offset)) + *sign(1.0_pReal,1.0_pReal-state(instance)%s_slip(j,of)) / & + (param(instance)%tausat_slip(f)+ssat_offset) right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- @@ -880,9 +872,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems gdot_slip(j) = param(instance)%gdot0_slip*0.5_pReal* & - ((abs(tau_slip_pos)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & + ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & + +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -902,9 +894,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! Calculation of dot vol frac tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F + gdot_twin(j) = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F param(instance)%gdot0_twin*& - (abs(tau_twin)/plasticState(ph)%state(nslip+j,of))**& + (abs(tau_twin)/state(instance)%s_twin(j,of))**& param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) enddo twinSystems1 enddo twinFamilies1 @@ -915,15 +907,15 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) slipFamilies2: do f = 1_pInt,size(param(instance)%Nslip,1) slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) j = j+1_pInt - plasticState(ph)%dotState(j,of) = & ! evolution of slip resistance j + dotState(instance)%s_slip(j,of) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & dot_product(interaction_SlipSlip(j,1:totalNslip(instance),instance), & right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor dot_product(interaction_SlipTwin(j,1:totalNtwin(instance),instance), & right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor - plasticState(ph)%dotState(index_Gamma,of) = plasticState(ph)%dotState(index_Gamma,of) + & + dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + & abs(gdot_slip(j)) - plasticState(ph)%dotState(offset_accshear_slip+j,of) = abs(gdot_slip(j)) + dotState(instance)%accshear_slip(j,of) = abs(gdot_slip(j)) enddo slipSystems2 enddo slipFamilies2 @@ -932,17 +924,17 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystems2: do i = 1_pInt,param(instance)%Ntwin(f) j = j+1_pInt - plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j + dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j c_TwinSlip * left_TwinSlip(j) * & dot_product(interaction_TwinSlip(j,1:totalNslip(instance),instance), & right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * left_TwinTwin(j) * & dot_product(interaction_TwinTwin(j,1:totalNtwin(instance),instance), & right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor - if (plasticState(ph)%state(index_F,of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 - plasticState(ph)%dotState(index_F,of) = plasticState(ph)%dotState(index_F,of) + & + if (state(instance)%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 + dotState(instance)%sumF(of) = dotState(instance)%sumF(of) + & gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) - plasticState(ph)%dotState(offset_accshear_twin+j,of) = abs(gdot_twin(j)) + dotState(instance)%accshear_twin(j,of) = abs(gdot_twin(j)) enddo twinSystems2 enddo twinFamilies2 From c3322b589e9360ec67679726d96e8fae09157be7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 30 Apr 2018 13:58:50 +0200 Subject: [PATCH 006/208] not needed anymore --- src/plastic_phenopowerlaw.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 042b80be3..c754e3127 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -814,9 +814,8 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) integer(pInt) :: & instance,ph, & - nSlip,nTwin, & f,i,j,k, & - index_myfamily, & + index_myFamily, & of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & From 51f56f5bad94de97fef1b214d6b2ddfdc6fed3e6 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Mon, 30 Apr 2018 21:30:53 +0200 Subject: [PATCH 007/208] using state pointers increases readability in constitutive results --- src/plastic_phenopowerlaw.f90 | 32 +++++++++++++------------------- 1 file changed, 13 insertions(+), 19 deletions(-) mode change 100644 => 100755 src/plastic_phenopowerlaw.f90 diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 old mode 100644 new mode 100755 index 042b80be3..acf6a4a44 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -832,6 +832,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) + plasticState(ph)%dotState(:,of) = 0.0_pReal !-------------------------------------------------------------------------------------------------- @@ -974,7 +975,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) instance,ph, of, & nSlip,nTwin, & o,f,i,c,j,k, & - index_Gamma,index_F,index_accshear_slip,index_accshear_twin,index_myFamily + index_myFamily real(pReal) :: & tau_slip_pos,tau_slip_neg,tau @@ -982,26 +983,19 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - nSlip = totalNslip(instance) - nTwin = totalNtwin(instance) - - index_Gamma = nSlip + nTwin + 1_pInt - index_F = nSlip + nTwin + 2_pInt - index_accshear_slip = nSlip + nTwin + 3_pInt - index_accshear_twin = nSlip + nTwin + 3_pInt + nSlip + plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) select case(plastic_phenopowerlaw_outputID(o,instance)) case (resistance_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(1:nSlip,of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%s_slip(of) c = c + nSlip case (accumulatedshear_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(index_accshear_slip:& - index_accshear_slip+nSlip-1_pInt,of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%accshear_slip(of) c = c + nSlip case (shearrate_slip_ID) @@ -1019,9 +1013,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo plastic_phenopowerlaw_postResults(c+j) = param(instance)%gdot0_slip*0.5_pReal* & - ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**param(instance)%n_slip & + ((abs(tau_slip_pos)/state(instance)%s_slip(j,of))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & + +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -1041,17 +1035,17 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (totalshear_ID) plastic_phenopowerlaw_postResults(c+1_pInt) = & - plasticState(ph)%state(index_Gamma,of) + state(instance)%sumGamma(of) c = c + 1_pInt case (resistance_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - plasticState(ph)%state(1_pInt+nSlip:1_pInt+nSlip+nTwin-1_pInt,of) + state(instance)%s_twin(of) c = c + nTwin case (accumulatedshear_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - plasticState(ph)%state(index_accshear_twin:index_accshear_twin+nTwin-1_pInt,of) + state(instance)%accshear_twin(of) c = c + nTwin case (shearrate_twin_ID) j = 0_pInt @@ -1060,9 +1054,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) twinSystems1: do i = 1_pInt,param(instance)%Ntwin(f) j = j + 1_pInt tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F + plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F param(instance)%gdot0_twin*& - (abs(tau)/plasticState(ph)%state(j+nSlip,of))**& + (abs(tau)/state(instance)%s_twin(j,of))**& param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) enddo twinSystems1 enddo twinFamilies1 @@ -1081,7 +1075,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + nTwin case (totalvolfrac_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt) = plasticState(ph)%state(index_F,of) + plastic_phenopowerlaw_postResults(c+1_pInt) = state(instance)%sumF(of) c = c + 1_pInt end select From 74956de9bd4f658ffd954f6d57ded22e7f32d4b5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 2 May 2018 16:06:30 +0200 Subject: [PATCH 008/208] misplaced bracket caused wrong results introduced in commit e3bd09d8 --- src/plastic_phenopowerlaw.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index c754e3127..f1d419c14 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -856,8 +856,8 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) right_SlipSlip(j) = abs(1.0_pReal-state(instance)%s_slip(j,of) / & (param(instance)%tausat_slip(f)+ssat_offset)) & **param(instance)%a_slip& - *sign(1.0_pReal,1.0_pReal-state(instance)%s_slip(j,of)) / & - (param(instance)%tausat_slip(f)+ssat_offset) + *sign(1.0_pReal,1.0_pReal-state(instance)%s_slip(j,of) / & + (param(instance)%tausat_slip(f)+ssat_offset)) right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- From 235b2fe3c89ead13ecfac6f45240716d6d9d7dfd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 2 May 2018 16:44:27 +0200 Subject: [PATCH 009/208] ntwin = [0] cause problems math_expand now works for sum(how) == 0 --- src/math.f90 | 3 +++ src/plastic_phenopowerlaw.f90 | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/math.f90 b/src/math.f90 index 4354354f7..82945a822 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -386,6 +386,9 @@ pure function math_expand(what,how) real(pReal), dimension(sum(how)) :: math_expand integer(pInt) :: i + if (sum(how) == 0_pInt) & + return + do i = 1_pInt, size(how) math_expand(sum(how(1:i-1))+1:sum(how(1:i))) = what(mod(i-1_pInt,size(what))+1_pInt) enddo diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index f1d419c14..ab65490d1 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -202,7 +202,7 @@ subroutine plastic_phenopowerlaw_init(fileUnit) allocate(totalNslip(maxNinstance), source=0_pInt) allocate(totalNtwin(maxNinstance), source=0_pInt) - allocate(param(maxNinstance)) ! one container of parameters per instance + allocate(param(maxNinstance)) ! one container of parameters per instance rewind(fileUnit) phase = 0_pInt From ccde78799ed638f6e10096f1034607549f8c5456 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 2 May 2018 17:33:42 +0200 Subject: [PATCH 010/208] using state pointers increases readability in postResults --- src/plastic_phenopowerlaw.f90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) mode change 100755 => 100644 src/plastic_phenopowerlaw.f90 diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 old mode 100755 new mode 100644 index d0452c04c..52fcf3ad3 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -982,7 +982,8 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - + nSlip= totalNslip(instance) + nTwin= totalNtwin(instance) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt @@ -990,11 +991,11 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) select case(plastic_phenopowerlaw_outputID(o,instance)) case (resistance_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%s_slip(of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%s_slip(1:nSlip,of) c = c + nSlip case (accumulatedshear_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%accshear_slip(of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%accshear_slip(1:nSlip,of) c = c + nSlip case (shearrate_slip_ID) @@ -1039,12 +1040,12 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (resistance_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state(instance)%s_twin(of) + state(instance)%s_twin(1:nTwin,of) c = c + nTwin case (accumulatedshear_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state(instance)%accshear_twin(of) + state(instance)%accshear_twin(1:nTwin,of) c = c + nTwin case (shearrate_twin_ID) j = 0_pInt From 804febe7f9ea954c2c66ddeec9f56331faab2007 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 May 2018 18:31:44 +0200 Subject: [PATCH 011/208] WIP: separate reading in and parsing --- src/math.f90 | 3 +- src/plastic_phenopowerlaw.f90 | 113 +++++++++++++++++++++------------- 2 files changed, 71 insertions(+), 45 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index f253a1b28..d53d80b40 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -160,8 +160,7 @@ module math math_rotate_forward33, & math_rotate_backward33, & math_rotate_forward3333, & - math_limit, & - math_expand + math_limit private :: & math_check, & halton diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 52fcf3ad3..c70d7220d 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -26,14 +26,11 @@ module plastic_phenopowerlaw totalNslip, & !< no. of slip system used in simulation totalNtwin !< no. of twin system used in simulation - - real(pReal), dimension(:,:,:), allocatable, private :: & - - interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) + interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) - interaction_TwinTwin !< interaction factors twin - twin (input parameter) + interaction_TwinTwin !< interaction factors twin - twin (input parameter) enum, bind(c) @@ -52,7 +49,16 @@ module plastic_phenopowerlaw integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & plastic_phenopowerlaw_outputID !< ID of each post result output + type :: tKeyValues + character(len=64) :: & + key = '' + character(len=65536) :: & + rawValues = '' + end type + type, private :: tParameters !< container type for internal constitutive parameters + type(tKeyValues) :: & + keyValues real(pReal) :: & gdot0_slip, & !< reference shear strain rate for slip gdot0_twin, & !< reference shear strain rate for twin @@ -172,6 +178,9 @@ subroutine plastic_phenopowerlaw_init(fileUnit) offset_slip, index_myFamily, index_otherFamily, & mySize=0_pInt,sizeState,sizeDotState, sizeDeltaState, & startIndex, endIndex + + type(tKeyValues) :: keyValuesTemp + character(len=65536) :: & tag = '', & line = '', & @@ -184,67 +193,85 @@ subroutine plastic_phenopowerlaw_init(fileUnit) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) + maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) ! ToDo: this does not happen if (maxNinstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(plastic_phenopowerlaw_sizePostResults(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),maxNinstance), & - source=0_pInt) + allocate(plastic_phenopowerlaw_sizePostResults(maxNinstance), source=0_pInt) + allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_output(maxval(phase_Noutput),maxNinstance)) - plastic_phenopowerlaw_output = '' - allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) - - allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) + plastic_phenopowerlaw_output = '' + allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) allocate(totalNslip(maxNinstance), source=0_pInt) allocate(totalNtwin(maxNinstance), source=0_pInt) allocate(param(maxNinstance)) ! one container of parameters per instance rewind(fileUnit) phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to + windForward: do while (IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + enddo windForward + getKeys: do while (trim(line) /= IO_EOF) ! read through sections of phase part line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_isBlank(line) .or. phase == 0_pInt) cycle ! skip empty lines + if (IO_getTag(line,'[',']') /= '') phase = phase + 1_pInt ! next phase + phase = phase + 1_pInt ! advance phase section counter + instance = phase_plasticityInstance(phase) ! instance of present phase + cycle + endif + if (phase_plasticity(phase) /= PLASTICITY_PHENOPOWERLAW_ID) cycle if (IO_getTag(line,'<','>') /= '') then ! stop at next part line = IO_read(fileUnit, .true.) ! reset IO_read exit endif - if (IO_getTag(line,'[',']') /= '') then ! next phase - phase = phase + 1_pInt ! advance phase section counter - if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then - instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase - Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase - Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) - Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) - Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) - Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) - Nchunks_nonSchmid = lattice_NnonSchmid(phase) - if(allocated(tempPerSlip)) deallocate(tempPerSlip) - !allocate(param(instance)%H_int,source=tempPerSlip) gfortran 5 does not support this - allocate(param(instance)%H_int(Nchunks_SlipFamilies),source=0.0_pReal) - allocate(param(instance)%interaction_SlipSlip(Nchunks_SlipSlip),source=0.0_pReal) - allocate(param(instance)%interaction_SlipTwin(Nchunks_SlipTwin),source=0.0_pReal) - allocate(param(instance)%interaction_TwinSlip(Nchunks_TwinSlip),source=0.0_pReal) - allocate(param(instance)%interaction_TwinTwin(Nchunks_TwinTwin),source=0.0_pReal) - allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid),source=0.0_pReal) + chunkPos = IO_stringPos(line) + keyValuesTemp%key = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + if(chunkPos(1) > 1) keyValuesTemp%rawValues = IO_lc(line(chunkPos(4),:)) + param(instance)%keyValues = [(instance)%keyValues,keyValuesTemp] + enddo getKeys - allocate(tempPerSlip(Nchunks_SlipFamilies)) - endif - cycle ! skip to next line + parseString: do instance = 1_pInt, maxNinstance + do i = 1_pInt, size(param(instance)%keyValues); key = param(instance)%keyValues(i) + enddo + enddo parseStrings + + myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then + instance = phase_plasticityInstance(phase) + + ! if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then + ! instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + ! chunkPos = IO_stringPos(line) + ! configTemp%key = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + ! if(chunkPos(1) > 1) configTemp%rawValues = IO_lc(line(chunkPos(4),:)) + ! config = [config,configTemp] + + ! Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase + ! Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase + ! Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) + ! Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) + ! Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) + ! Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) + ! Nchunks_nonSchmid = lattice_NnonSchmid(phase) + ! if(allocated(tempPerSlip)) deallocate(tempPerSlip) + ! !allocate(param(instance)%H_int,source=tempPerSlip) gfortran 5 does not support this + ! allocate(param(instance)%H_int(Nchunks_SlipFamilies),source=0.0_pReal) + ! allocate(param(instance)%interaction_SlipSlip(Nchunks_SlipSlip),source=0.0_pReal) + ! allocate(param(instance)%interaction_SlipTwin(Nchunks_SlipTwin),source=0.0_pReal) + ! allocate(param(instance)%interaction_TwinSlip(Nchunks_TwinSlip),source=0.0_pReal) + ! allocate(param(instance)%interaction_TwinTwin(Nchunks_TwinTwin),source=0.0_pReal) + ! allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid),source=0.0_pReal) + + ! allocate(tempPerSlip(Nchunks_SlipFamilies)) + ! endif + ! cycle ! skip to next line endif if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran - - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') From 7db08f0a76b310e4328aca190a0160e71c3517cb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 22:56:20 +0200 Subject: [PATCH 012/208] using material.config values from main memory --- src/constitutive.f90 | 2 +- src/plastic_phenopowerlaw.f90 | 683 ++++++++++++---------------------- 2 files changed, 241 insertions(+), 444 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e2a3f0260..a7ca64506 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -157,7 +157,7 @@ subroutine constitutive_init() ! parse plasticities from config file if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init - if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(FILEUNIT) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index c70d7220d..3cc03ef1e 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -10,55 +10,27 @@ module plastic_phenopowerlaw implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_phenopowerlaw_sizePostResults !< cumulative size of post results - integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_phenopowerlaw_sizePostResult !< size of each post result output - + plastic_phenopowerlaw_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_phenopowerlaw_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - plastic_phenopowerlaw_Noutput !< number of outputs per instance of this constitution - - integer(pInt), dimension(:), allocatable, private :: & - totalNslip, & !< no. of slip system used in simulation - totalNtwin !< no. of twin system used in simulation - - real(pReal), dimension(:,:,:), allocatable, private :: & - interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) - interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) - interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) - interaction_TwinTwin !< interaction factors twin - twin (input parameter) - + plastic_phenopowerlaw_output !< name of each post result output enum, bind(c) - enumerator :: undefined_ID, & - resistance_slip_ID, & - accumulatedshear_slip_ID, & - shearrate_slip_ID, & - resolvedstress_slip_ID, & - totalshear_ID, & - resistance_twin_ID, & - accumulatedshear_twin_ID, & - shearrate_twin_ID, & - resolvedstress_twin_ID, & - totalvolfrac_twin_ID + enumerator :: & + undefined_ID, & + resistance_slip_ID, & + accumulatedshear_slip_ID, & + shearrate_slip_ID, & + resolvedstress_slip_ID, & + totalshear_ID, & + resistance_twin_ID, & + accumulatedshear_twin_ID, & + shearrate_twin_ID, & + resolvedstress_twin_ID, & + totalvolfrac_twin_ID end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - plastic_phenopowerlaw_outputID !< ID of each post result output - - type :: tKeyValues - character(len=64) :: & - key = '' - character(len=65536) :: & - rawValues = '' - end type type, private :: tParameters !< container type for internal constitutive parameters - type(tKeyValues) :: & - keyValues real(pReal) :: & gdot0_slip, & !< reference shear strain rate for slip gdot0_twin, & !< reference shear strain rate for twin @@ -73,9 +45,9 @@ module plastic_phenopowerlaw h0_TwinSlip, & !< reference hardening twin - slip h0_TwinTwin, & !< reference hardening twin - twin a_slip, & - aTolResistance = 1.0_pReal, & ! default absolute tolerance 1 Pa - aTolShear = 1.0e-6_pReal, & ! default absolute tolerance 1e-6 - aTolTwinfrac = 1.0e-6_pReal ! default absolute tolerance 1e-6 + aTolResistance, & ! default absolute tolerance 1 Pa + aTolShear, & ! default absolute tolerance 1e-6 + aTolTwinfrac ! default absolute tolerance 1e-6 integer(pInt), dimension(:), allocatable :: & Nslip, & !< active number of slip systems per family Ntwin !< active number of twin systems per family @@ -85,13 +57,21 @@ module plastic_phenopowerlaw tausat_slip, & !< maximum critical shear stress for slip nonSchmidCoeff, & H_int, & !< per family hardening activity (optional) - interaction_SlipSlip, & !< slip resistance from slip activity interaction_SlipTwin, & !< slip resistance from twin activity interaction_TwinSlip, & !< twin resistance from slip activity interaction_TwinTwin !< twin resistance from twin activity + real(pReal), dimension(:,:), allocatable :: & + matrix_SlipSlip, & !< slip resistance from slip activity + matrix_SlipTwin, & !< slip resistance from twin activity + matrix_TwinSlip, & !< twin resistance from slip activity + matrix_TwinTwin !< twin resistance from twin activity + + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID !< ID of each post result output end type - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + type(tParameters), dimension(:), allocatable, target, private :: param !< containers of constitutive parameters (len Ninstance) type, private :: tPhenopowerlawState real(pReal), pointer, dimension(:,:) :: & @@ -121,7 +101,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_init(fileUnit) +subroutine plastic_phenopowerlaw_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -158,387 +138,202 @@ subroutine plastic_phenopowerlaw_init(fileUnit) PLASTICITY_PHENOPOWERLAW_ID, & material_phase, & plasticState, & - MATERIAL_partPhase + MATERIAL_partPhase, & + phaseConfig + use lattice use numerics,only: & numerics_integrator implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & maxNinstance, & - instance,phase,j,k, f,o, & - Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, & - Nchunks_TwinSlip = 0_pInt, Nchunks_TwinTwin = 0_pInt, & - Nchunks_SlipFamilies = 0_pInt, Nchunks_TwinFamilies = 0_pInt, & - Nchunks_TransFamilies = 0_pInt, Nchunks_nonSchmid = 0_pInt, & - NipcMyPhase, & + instance,phase,j,k, f,o, i,& + NipcMyPhase, outputSize, & offset_slip, index_myFamily, index_otherFamily, & - mySize=0_pInt,sizeState,sizeDotState, sizeDeltaState, & + sizeState,sizeDotState, sizeDeltaState, & startIndex, endIndex + integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] + real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] - type(tKeyValues) :: keyValuesTemp + type(tParameters), pointer :: p + + integer(kind(undefined_ID)) :: & + outputID !< ID of each post result output character(len=65536) :: & - tag = '', & - line = '', & extmsg = '' - character(len=64) :: & - outputtag = '' - real(pReal), dimension(:), allocatable :: tempPerSlip + character(len=64), dimension(:), allocatable :: outputs write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) ! ToDo: this does not happen - if (maxNinstance == 0_pInt) return - + maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(plastic_phenopowerlaw_sizePostResults(maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_output(maxval(phase_Noutput),maxNinstance)) plastic_phenopowerlaw_output = '' - allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) - allocate(totalNslip(maxNinstance), source=0_pInt) - allocate(totalNtwin(maxNinstance), source=0_pInt) allocate(param(maxNinstance)) ! one container of parameters per instance - - rewind(fileUnit) - phase = 0_pInt - windForward: do while (IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) - line = IO_read(fileUnit) - enddo windForward - getKeys: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line) .or. phase == 0_pInt) cycle ! skip empty lines - if (IO_getTag(line,'[',']') /= '') phase = phase + 1_pInt ! next phase - phase = phase + 1_pInt ! advance phase section counter - instance = phase_plasticityInstance(phase) ! instance of present phase - cycle - endif - if (phase_plasticity(phase) /= PLASTICITY_PHENOPOWERLAW_ID) cycle - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - chunkPos = IO_stringPos(line) - keyValuesTemp%key = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - if(chunkPos(1) > 1) keyValuesTemp%rawValues = IO_lc(line(chunkPos(4),:)) - param(instance)%keyValues = [(instance)%keyValues,keyValuesTemp] - enddo getKeys - - parseString: do instance = 1_pInt, maxNinstance - do i = 1_pInt, size(param(instance)%keyValues); key = param(instance)%keyValues(i) - enddo - enddo parseStrings - - myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then - instance = phase_plasticityInstance(phase) - - ! if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then - ! instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - ! chunkPos = IO_stringPos(line) - ! configTemp%key = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - ! if(chunkPos(1) > 1) configTemp%rawValues = IO_lc(line(chunkPos(4),:)) - ! config = [config,configTemp] - - ! Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase - ! Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase - ! Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) - ! Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) - ! Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) - ! Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) - ! Nchunks_nonSchmid = lattice_NnonSchmid(phase) - ! if(allocated(tempPerSlip)) deallocate(tempPerSlip) - ! !allocate(param(instance)%H_int,source=tempPerSlip) gfortran 5 does not support this - ! allocate(param(instance)%H_int(Nchunks_SlipFamilies),source=0.0_pReal) - ! allocate(param(instance)%interaction_SlipSlip(Nchunks_SlipSlip),source=0.0_pReal) - ! allocate(param(instance)%interaction_SlipTwin(Nchunks_SlipTwin),source=0.0_pReal) - ! allocate(param(instance)%interaction_TwinSlip(Nchunks_TwinSlip),source=0.0_pReal) - ! allocate(param(instance)%interaction_TwinTwin(Nchunks_TwinTwin),source=0.0_pReal) - ! allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid),source=0.0_pReal) - - ! allocate(tempPerSlip(Nchunks_SlipFamilies)) - ! endif - ! cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - - case ('(output)') - outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt ! assume valid output - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = outputtag ! assume valid output - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('resistance_slip') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_slip_ID - - case ('accumulatedshear_slip','accumulated_shear_slip') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_slip_ID - - case ('shearrate_slip') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_slip_ID - - case ('resolvedstress_slip') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_slip_ID - - case ('totalshear') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalshear_ID - - case ('resistance_twin') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_twin_ID - - case ('accumulatedshear_twin','accumulated_shear_twin') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_twin_ID - - case ('shearrate_twin') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_twin_ID - - case ('resolvedstress_twin') - - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_twin_ID - - case ('totalvolfrac_twin') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalvolfrac_twin_ID - - case default - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) - 1_pInt ! correct for invalid - - end select - -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of slip families - case ('nslip') - if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) call IO_warning(50_pInt,ext_msg=extmsg) - if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) - allocate(param(instance)%Nslip(Nchunks_SlipFamilies),source=-1_pInt) - do j = 1_pInt, Nchunks_SlipFamilies - param(instance)%Nslip(j) = min(IO_intValue(line,chunkPos,1_pInt+j), & - lattice_NslipSystem(j,phase)) ! limit active slip systems per family to min of available and requested - enddo - totalNslip(instance) = sum(param(instance)%Nslip) ! how many slip systems altogether - - case ('tausat_slip','tau0_slip','h_int') - tempPerSlip = 0.0_pReal - do j = 1_pInt, Nchunks_SlipFamilies - if (param(instance)%Nslip(j) > 0_pInt) & - tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - select case(tag) ! here, all arrays are allocated automatically - case ('tausat_slip') - param(instance)%tausat_slip = tempPerSlip - case ('tau0_slip') - param(instance)%tau0_slip = tempPerSlip - case ('h_int') - param(instance)%H_int = tempPerSlip - end select - -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of twin families - case ('ntwin') - if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) call IO_warning(51_pInt,ext_msg=extmsg) - if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - Nchunks_TwinFamilies = chunkPos(1) - 1_pInt - allocate(param(instance)%Ntwin(Nchunks_TwinFamilies),source=-1_pInt) - do j = 1_pInt, Nchunks_TwinFamilies - param(instance)%Ntwin(j) = min(IO_intValue(line,chunkPos,1_pInt+j), & - lattice_NtwinSystem(j,phase)) ! limit active twin systems per family to min of available and requested - enddo - totalNtwin(instance) = sum(param(instance)%Ntwin) ! how many twin systems altogether - - case ('tau0_twin') - allocate(param(instance)%tau0_twin(Nchunks_TwinFamilies),source=0.0_pReal) - do j = 1_pInt, Nchunks_TwinFamilies - if (param(instance)%Ntwin(j) > 0_pInt) & - param(instance)%tau0_twin(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of interactions - case ('interaction_slipslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) call IO_warning(52_pInt,ext_msg=extmsg) - do j = 1_pInt, Nchunks_SlipSlip - param(instance)%interaction_SlipSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('interaction_sliptwin') - if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) call IO_warning(52_pInt,ext_msg=extmsg) - do j = 1_pInt, Nchunks_SlipTwin - param(instance)%interaction_SlipTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('interaction_twinslip') - if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) call IO_warning(52_pInt,ext_msg=extmsg) - do j = 1_pInt, Nchunks_TwinSlip - param(instance)%interaction_TwinSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('interaction_twintwin') - if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) call IO_warning(52_pInt,ext_msg=extmsg) - do j = 1_pInt, Nchunks_TwinTwin - param(instance)%interaction_TwinTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('nonschmid_coefficients') - if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) call IO_warning(52_pInt,ext_msg=extmsg) - do j = 1_pInt,Nchunks_nonSchmid - param(instance)%nonSchmidCoeff(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - -!-------------------------------------------------------------------------------------------------- -! parameters independent of number of slip/twin systems - case ('gdot0_slip') - param(instance)%gdot0_slip = IO_floatValue(line,chunkPos,2_pInt) - case ('n_slip') - param(instance)%n_slip = IO_floatValue(line,chunkPos,2_pInt) - case ('a_slip', 'w0_slip') - param(instance)%a_slip = IO_floatValue(line,chunkPos,2_pInt) - case ('gdot0_twin') - param(instance)%gdot0_twin = IO_floatValue(line,chunkPos,2_pInt) - case ('n_twin') - param(instance)%n_twin = IO_floatValue(line,chunkPos,2_pInt) - case ('s_pr') - param(instance)%spr = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_b') - param(instance)%twinB = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_c') - param(instance)%twinC = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_d') - param(instance)%twinD = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_e') - param(instance)%twinE = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_slipslip') - param(instance)%h0_SlipSlip = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_twinslip') - param(instance)%h0_TwinSlip = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_twintwin') - param(instance)%h0_TwinTwin = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_resistance') - param(instance)%aTolResistance = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_shear') - param(instance)%aTolShear = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_twinfrac') - param(instance)%aTolTwinfrac = IO_floatValue(line,chunkPos,2_pInt) - case default - - end select - endif; endif - enddo parsingFile - - sanityChecks: do phase = 1_pInt, size(phase_plasticity) - myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then - instance = phase_plasticityInstance(phase) - totalNslip(instance) = sum(param(instance)%Nslip) ! how many slip systems altogether. ToDo: ok for unallocated Nslip - totalNtwin(instance) = sum(param(instance)%Ntwin) ! how many twin systems altogether. ToDo: ok for unallocated Ntwin - slipActive: if (allocated(param(instance)%Nslip)) then - if (any(param(instance)%tau0_slip < 0.0_pReal .and. & - param(instance)%Nslip(:) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%gdot0_slip <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%n_slip <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(param(instance)%tausat_slip <= 0.0_pReal .and. & - param(instance)%Nslip(:) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(dEq0(param(instance)%a_slip) .and. param(instance)%Nslip(:) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - endif slipActive - - twinActive: if (allocated(param(instance)%Ntwin)) then - ! if (any(param(instance)%tau0_twin < 0.0_pReal .and. & - ! param(instance)%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - ! if ( param(instance)%gdot0_twin <= 0.0_pReal .and. & - ! any(param(instance)%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - ! if ( param(instance)%n_twin <= 0.0_pReal .and. & - ! any(param(instance)%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - endif twinActive - - if (param(instance)%aTolResistance <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolResistance ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%aTolShear <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolShear ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%aTolTwinfrac <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') - endif myPhase - enddo sanityChecks - - - !-------------------------------------------------------------------------------------------------- -! allocation of variables whose size depends on the total number of active slip systems - allocate(interaction_SlipSlip(maxval(totalNslip),maxval(totalNslip),maxNinstance), source=0.0_pReal) - allocate(interaction_SlipTwin(maxval(totalNslip),maxval(totalNtwin),maxNinstance), source=0.0_pReal) - allocate(interaction_TwinSlip(maxval(totalNtwin),maxval(totalNslip),maxNinstance), source=0.0_pReal) - allocate(interaction_TwinTwin(maxval(totalNtwin),maxval(totalNtwin),maxNinstance), source=0.0_pReal) - - allocate(state(maxNinstance)) allocate(dotState(maxNinstance)) - initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop through all phases in material.config + do phase = 1_pInt, size(phase_plasticityInstance) + if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then + instance = phase_plasticityInstance(phase) + p => param(instance) - myPhase2: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then ! only consider my phase - NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase - instance = phase_plasticityInstance(phase) ! which instance of my phase + p%Nslip = phaseConfig(phase)%getIntArray('nslip',defaultVal=emptyInt) + !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) + if (sum(p%Nslip) > 0_pInt) then + p%tau0_slip = phaseConfig(phase)%getFloatArray('tau0_slip') + p%tausat_slip = phaseConfig(phase)%getFloatArray('tausat_slip') + p%H_int = phaseConfig(phase)%getFloatArray('h_int',defaultVal=[(0.0_pReal,i=1_pInt,size(p%Nslip))]) + print*, (shape(p%H_int)) + print*, (shape(p%Nslip)) + p%interaction_SlipSlip = phaseConfig(phase)%getFloatArray('interaction_slipslip') + p%nonSchmidCoeff = phaseConfig(phase)%getFloatArray('nonschmid_coefficients',& + defaultVal = [real(pReal)::1] ) + p%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') + p%n_slip = phaseConfig(phase)%getFloat('n_slip') + p%a_slip = phaseConfig(phase)%getFloat('a_slip') + p%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') + endif + + p%Ntwin = phaseConfig(phase)%getIntArray('ntwin', defaultVal=emptyInt) + !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) + if (sum(p%Ntwin) > 0_pInt) then + p%tau0_twin = phaseConfig(phase)%getFloatArray('tau0_twin') + p%interaction_TwinTwin = phaseConfig(phase)%getFloatArray('interaction_twintwin') + p%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') + p%n_twin = phaseConfig(phase)%getFloat('n_twin') + p%spr = phaseConfig(phase)%getFloat('s_pr') + p%twinB = phaseConfig(phase)%getFloat('twin_b') + p%twinC = phaseConfig(phase)%getFloat('twin_c') + p%twinD = phaseConfig(phase)%getFloat('twin_d') + p%twinE = phaseConfig(phase)%getFloat('twin_e') + p%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') + endif + if (sum(p%Nslip) > 0_pInt .and. sum(p%Ntwin) > 0_pInt) then + p%interaction_SlipTwin = phaseConfig(phase)%getFloatArray('interaction_sliptwin') + p%interaction_TwinSlip = phaseConfig(phase)%getFloatArray('interaction_twinslip') + p%h0_TwinSlip = phaseConfig(phase)%getFloat('h0_twinslip') + endif + + allocate(p%matrix_SlipSlip(sum(p%Nslip),sum(p%Nslip)),source =0.0_pReal) + allocate(p%matrix_SlipTwin(sum(p%Nslip),sum(p%Ntwin)),source =0.0_pReal) + allocate(p%matrix_TwinSlip(sum(p%Ntwin),sum(p%Nslip)),source =0.0_pReal) + allocate(p%matrix_TwinTwin(sum(p%Ntwin),sum(p%Ntwin)),source =0.0_pReal) + p%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) + p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + p%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + outputs = phaseConfig(phase)%getStrings('(output)') + allocate(p%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + case ('resistance_slip') + outputID = resistance_slip_ID + outputSize = sum(p%Nslip) + case ('acumulatedshear_slip','accumulated_shear_slip') + outputID = accumulatedshear_slip_ID + outputSize = sum(p%Nslip) + case ('shearrate_slip') + outputID = shearrate_slip_ID + outputSize = sum(p%Nslip) + case ('resolvedstress_slip') + outputID = resolvedstress_slip_ID + outputSize = sum(p%Nslip) + + case ('resistance_twin') + outputID = resistance_twin_ID + outputSize = sum(p%Ntwin) + case ('accumulatedshear_twin','accumulated_shear_twin') + outputID = accumulatedshear_twin_ID + outputSize = sum(p%Ntwin) + case ('shearrate_twin') + outputID = shearrate_twin_ID + outputSize = sum(p%Ntwin) + case ('resolvedstress_twin') + outputID = resolvedstress_twin_ID + outputSize = sum(p%Ntwin) + + case ('totalvolfrac_twin') + outputID = totalvolfrac_twin_ID + outputSize = 1_pInt + case ('totalshear') + outputID = totalshear_ID + outputSize = 1_pInt + end select + + if (outputID /= undefined_ID) then + plastic_phenopowerlaw_output(i,instance) = outputs(i) + plastic_phenopowerlaw_sizePostResult(i,instance) = outputSize + p%outputID = [p%outputID , outputID] + endif + + end do !-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) - select case(plastic_phenopowerlaw_outputID(o,instance)) - case(resistance_slip_ID, & - shearrate_slip_ID, & - accumulatedshear_slip_ID, & - resolvedstress_slip_ID & - ) - mySize = totalNslip(instance) - case(resistance_twin_ID, & - shearrate_twin_ID, & - accumulatedshear_twin_ID, & - resolvedstress_twin_ID & - ) - mySize = totalNtwin(instance) - case(totalshear_ID, & - totalvolfrac_twin_ID & - ) - mySize = 1_pInt - case default - end select +! parameters independent of number of slip/twin systems +extmsg = '' +if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " +if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " +if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " +if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " + if (extmsg /= '') call IO_error(211_pInt,ip=instance,& + ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') + +if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tau0_slip' " +if (any(p%tau0_slip < p%tausat_slip .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tausat_slip' " +if (any(p%gdot0_slip <= 0.0_pReal .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tausat_slip' " +if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " + + !if (any(dEq0(p%a_slip) .and. sum(p%Nslip) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + + ! if (any(p%tau0_twin < 0.0_pReal .and. & + ! p%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + ! if ( p%gdot0_twin <= 0.0_pReal .and. & + ! any(p%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + ! if ( p%n_twin <= 0.0_pReal .and. & + ! any(p%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + + if (p%aTolResistance <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolResistance ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (p%aTolShear <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolShear ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (p%aTolTwinfrac <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') + + + + + NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase - outputFound: if (mySize > 0_pInt) then - plastic_phenopowerlaw_sizePostResult(o,instance) = mySize - plastic_phenopowerlaw_sizePostResults(instance) = plastic_phenopowerlaw_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop !-------------------------------------------------------------------------------------------------- ! allocate state arrays - sizeState = totalNslip(instance) & ! s_slip - + totalNtwin(instance) & ! s_twin - + 2_pInt & ! sum(gamma) + sum(f) - + totalNslip(instance) & ! accshear_slip - + totalNtwin(instance) ! accshear_twin + sizeState = size(['tau_slip ','accshear_slip']) * sum(p%nslip) & + + size(['tau_twin ','accshear_twin']) * sum(p%ntwin) & + + size(['sum(gamma)', 'sum(f) ']) sizeDotState = sizeState sizeDeltaState = 0_pInt plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = plastic_phenopowerlaw_sizePostResults(instance) - plasticState(phase)%nSlip =totalNslip(instance) - plasticState(phase)%nTwin =totalNtwin(instance) - plasticState(phase)%nTrans=0_pInt + plasticState(phase)%nSlip = sum(p%Nslip) + plasticState(phase)%nTwin = sum(p%Ntwin) allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) @@ -562,26 +357,26 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) !-------------------------------------------------------------------------------------------------- -! calculate hardening matrices and extend intitial values (per family -> per system) - mySlipFamilies: do f = 1_pInt,size(param(instance)%Nslip,1) ! >>> interaction slip -- X - index_myFamily = sum(param(instance)%Nslip(1:f-1_pInt)) - - mySlipSystems: do j = 1_pInt,param(instance)%Nslip(f) - otherSlipFamilies: do o = 1_pInt,size(param(instance)%Nslip,1) - index_otherFamily = sum(param(instance)%Nslip(1:o-1_pInt)) - otherSlipSystems: do k = 1_pInt,param(instance)%Nslip(o) - interaction_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & - param(instance)%interaction_SlipSlip(lattice_interactionSlipSlip( & +! calculate hardening matrices + mySlipFamilies: do f = 1_pInt,size(p%Nslip,1) ! >>> interaction slip -- X + index_myFamily = sum(p%Nslip(1:f-1_pInt)) + + mySlipSystems: do j = 1_pInt,p%Nslip(f) + otherSlipFamilies: do o = 1_pInt,size(p%Nslip,1) + index_otherFamily = sum(p%Nslip(1:o-1_pInt)) + otherSlipSystems: do k = 1_pInt,p%Nslip(o) + p%matrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & + p%interaction_SlipSlip(lattice_interactionSlipSlip( & sum(lattice_NslipSystem(1:f-1,phase))+j, & sum(lattice_NslipSystem(1:o-1,phase))+k, & phase)) enddo otherSlipSystems; enddo otherSlipFamilies - twinFamilies: do o = 1_pInt,size(param(instance)%Ntwin,1) - index_otherFamily = sum(param(instance)%Ntwin(1:o-1_pInt)) - twinSystems: do k = 1_pInt,param(instance)%Ntwin(o) - interaction_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & - param(instance)%interaction_SlipTwin(lattice_interactionSlipTwin( & + twinFamilies: do o = 1_pInt,size(p%Ntwin,1) + index_otherFamily = sum(p%Ntwin(1:o-1_pInt)) + twinSystems: do k = 1_pInt,p%Ntwin(o) + p%matrix_SlipTwin(index_myFamily+j,index_otherFamily+k) = & + p%interaction_SlipTwin(lattice_interactionSlipTwin( & sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & phase)) @@ -589,24 +384,24 @@ subroutine plastic_phenopowerlaw_init(fileUnit) enddo mySlipSystems enddo mySlipFamilies - myTwinFamilies: do f = 1_pInt,size(param(instance)%Ntwin,1) ! >>> interaction twin -- X - index_myFamily = sum(param(instance)%Ntwin(1:f-1_pInt)) - myTwinSystems: do j = 1_pInt,param(instance)%Ntwin(f) - slipFamilies: do o = 1_pInt,size(param(instance)%Nslip,1) - index_otherFamily = sum(param(instance)%Nslip(1:o-1_pInt)) - slipSystems: do k = 1_pInt,param(instance)%Nslip(o) - interaction_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & - param(instance)%interaction_TwinSlip(lattice_interactionTwinSlip( & + myTwinFamilies: do f = 1_pInt,size(p%Ntwin,1) ! >>> interaction twin -- X + index_myFamily = sum(p%Ntwin(1:f-1_pInt)) + myTwinSystems: do j = 1_pInt,p%Ntwin(f) + slipFamilies: do o = 1_pInt,size(p%Nslip,1) + index_otherFamily = sum(p%Nslip(1:o-1_pInt)) + slipSystems: do k = 1_pInt,p%Nslip(o) + p%matrix_TwinSlip(index_myFamily+j,index_otherFamily+k) = & + p%interaction_TwinSlip(lattice_interactionTwinSlip( & sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & phase)) enddo slipSystems; enddo slipFamilies - otherTwinFamilies: do o = 1_pInt,size(param(instance)%Ntwin,1) - index_otherFamily = sum(param(instance)%Ntwin(1:o-1_pInt)) - otherTwinSystems: do k = 1_pInt,param(instance)%Ntwin(o) - interaction_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & - param(instance)%interaction_TwinTwin(lattice_interactionTwinTwin( & + otherTwinFamilies: do o = 1_pInt,size(p%Ntwin,1) + index_otherFamily = sum(p%Ntwin(1:o-1_pInt)) + otherTwinSystems: do k = 1_pInt,p%Ntwin(o) + p%matrix_TwinTwin(index_myFamily+j,index_otherFamily+k) = & + p%interaction_TwinTwin(lattice_interactionTwinTwin( & sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & phase)) @@ -617,51 +412,51 @@ subroutine plastic_phenopowerlaw_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState startIndex = 1_pInt - endIndex = totalNslip(instance) + endIndex = plasticState(phase)%nSlip state (instance)%s_slip=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%s_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%state0(startIndex:endIndex,:) = & - spread(math_expand(param(instance)%tau0_slip, param(instance)%Nslip), 2, NipcMyPhase) + spread(math_expand(p%tau0_slip, p%Nslip), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolResistance + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolResistance startIndex = endIndex + 1_pInt - endIndex = endIndex + totalNtwin(instance) + endIndex = endIndex + plasticState(phase)%nTwin state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%state0(startIndex:endIndex,:) = & - spread(math_expand(param(instance)%tau0_twin, param(instance)%Ntwin), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolResistance + spread(math_expand(p%tau0_twin, p%Ntwin), 2, NipcMyPhase) + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumGamma=>plasticState(phase)%state (startIndex,:) dotState(instance)%sumGamma=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumF=>plasticState(phase)%state (startIndex,:) dotState(instance)%sumF=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolTwinFrac + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolTwinFrac startIndex = endIndex + 1_pInt - endIndex = endIndex + totalNslip(instance) + endIndex = endIndex + plasticState(phase)%nSlip state (instance)%accshear_slip=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear ! global alias plasticState(phase)%slipRate =>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%accumulatedSlip =>plasticState(phase)%state(startIndex:endIndex,:) startIndex = endIndex + 1_pInt - endIndex = endIndex + totalNtwin(instance) + endIndex = endIndex + plasticState(phase)%nTwin state (instance)%accshear_twin=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear - endif myPhase2 - enddo initializeInstances + endif + enddo end subroutine plastic_phenopowerlaw_init @@ -740,7 +535,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, tau_slip_neg = tau_slip_pos nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) - do k = 1,lattice_NnonSchmid(ph) + do k = 1,size(param(instance)%nonSchmidCoeff) tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) tau_slip_neg = tau_slip_neg + param(instance)%nonSchmidCoeff(k)* & @@ -842,22 +637,24 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) integer(pInt) :: & instance,ph, & f,i,j,k, & - index_myFamily, & + index_myFamily, nslip,ntwin,& of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & ssat_offset, & tau_slip_pos,tau_slip_neg,tau_twin - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Nslip) :: & gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip - real(pReal), dimension(totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Ntwin) :: & gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) + nSlip= sum(param(instance)%nslip) + nTwin= sum(param(instance)%nTwin) plasticState(ph)%dotState(:,of) = 0.0_pReal @@ -936,9 +733,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) j = j+1_pInt dotState(instance)%s_slip(j,of) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & - dot_product(interaction_SlipSlip(j,1:totalNslip(instance),instance), & + dot_product(param(instance)%matrix_SlipSlip(j,1:nslip), & right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(interaction_SlipTwin(j,1:totalNtwin(instance),instance), & + dot_product(param(instance)%matrix_SlipTwin(j,1:ntwin), & right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + & abs(gdot_slip(j)) @@ -953,10 +750,10 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) j = j+1_pInt dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j c_TwinSlip * left_TwinSlip(j) * & - dot_product(interaction_TwinSlip(j,1:totalNslip(instance),instance), & + dot_product(param(instance)%matrix_TwinSlip(j,1:nslip), & right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * left_TwinTwin(j) * & - dot_product(interaction_TwinTwin(j,1:totalNtwin(instance),instance), & + dot_product(param(instance)%matrix_TwinTwin(j,1:ntwin), & right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (state(instance)%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 dotState(instance)%sumF(of) = dotState(instance)%sumF(of) + & @@ -994,7 +791,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) ip, & !< integration point el !< element !< microstructure state - real(pReal), dimension(plastic_phenopowerlaw_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & plastic_phenopowerlaw_postResults integer(pInt) :: & @@ -1009,14 +806,14 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - nSlip= totalNslip(instance) - nTwin= totalNtwin(instance) - + nSlip= sum(param(instance)%nslip) + nTwin= sum(param(instance)%nTwin) + plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt - outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) - select case(plastic_phenopowerlaw_outputID(o,instance)) + outputsLoop: do o = 1_pInt,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) case (resistance_slip_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%s_slip(1:nSlip,of) c = c + nSlip From a0a5d4c549e9a348f3b62e4a10506527bc282618 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 05:38:45 +0200 Subject: [PATCH 013/208] only doing things that are required rely on default values where applicable --- src/plastic_none.f90 | 50 +++++++++++++------------------------------- 1 file changed, 14 insertions(+), 36 deletions(-) diff --git a/src/plastic_none.f90 b/src/plastic_none.f90 index 140754556..5470c4a43 100644 --- a/src/plastic_none.f90 +++ b/src/plastic_none.f90 @@ -4,16 +4,9 @@ !> @brief material subroutine for purely elastic material !-------------------------------------------------------------------------------------------------- module plastic_none - use prec, only: & - pInt implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_none_sizePostResults - - integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_none_sizePostResult !< size of each post result output public :: & plastic_none_init @@ -31,6 +24,8 @@ subroutine plastic_none_init compiler_version, & compiler_options #endif + use prec, only: & + pInt use debug, only: & debug_level, & debug_constitutive, & @@ -51,18 +46,13 @@ subroutine plastic_none_init integer(pInt) :: & maxNinstance, & phase, & - NofMyPhase, & - sizeState, & - sizeDotState, & - sizeDeltaState + NofMyPhase write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONE_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" maxNinstance = int(count(phase_plasticity == PLASTICITY_none_ID),pInt) - if (maxNinstance == 0_pInt) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance @@ -70,37 +60,25 @@ subroutine plastic_none_init if (phase_plasticity(phase) == PLASTICITY_none_ID) then NofMyPhase=count(material_phase==phase) - sizeState = 0_pInt - plasticState(phase)%sizeState = sizeState - sizeDotState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - sizeDeltaState = 0_pInt - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = 0_pInt - plasticState(phase)%nSlip = 0_pInt - plasticState(phase)%nTwin = 0_pInt - plasticState(phase)%nTrans = 0_pInt - allocate(plasticState(phase)%aTolState (sizeState)) - allocate(plasticState(phase)%state0 (sizeState,NofMyPhase)) - allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase)) - allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase)) - allocate(plasticState(phase)%state (sizeState,NofMyPhase)) + allocate(plasticState(phase)%aTolState (0_pInt)) + allocate(plasticState(phase)%state0 (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%partionedState0 (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%subState0 (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%state (0_pInt,NofMyPhase)) - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase)) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase)) + allocate(plasticState(phase)%dotState (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%deltaState (0_pInt,NofMyPhase)) if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase)) - allocate(plasticState(phase)%previousDotState2(sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%previousDotState (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%previousDotState2(0_pInt,NofMyPhase)) endif if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%RK4dotState (0_pInt,NofMyPhase)) if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%RKCK45dotState (6,0_pInt,NofMyPhase)) endif enddo initializeInstances - allocate(plastic_none_sizePostResults(maxNinstance), source=0_pInt) - end subroutine plastic_none_init end module plastic_none From 29a0ec280083e8eb4fe6f97bf38631be301108cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 05:39:40 +0200 Subject: [PATCH 014/208] polishing --- src/plastic_phenopowerlaw.f90 | 118 ++++++++++++++++------------------ 1 file changed, 55 insertions(+), 63 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 3cc03ef1e..a06a31a88 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -118,18 +118,9 @@ subroutine plastic_phenopowerlaw_init math_Voigt66to3333, & math_expand use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use material, only: & phase_plasticity, & phase_plasticityInstance, & @@ -152,17 +143,18 @@ subroutine plastic_phenopowerlaw_init instance,phase,j,k, f,o, i,& NipcMyPhase, outputSize, & offset_slip, index_myFamily, index_otherFamily, & - sizeState,sizeDotState, sizeDeltaState, & + sizeState,sizeDotState, & startIndex, endIndex + integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] - real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] + real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] type(tParameters), pointer :: p integer(kind(undefined_ID)) :: & outputID !< ID of each post result output - character(len=65536) :: & + character(len=512) :: & extmsg = '' character(len=64), dimension(:), allocatable :: outputs @@ -190,18 +182,18 @@ subroutine plastic_phenopowerlaw_init p%Nslip = phaseConfig(phase)%getIntArray('nslip',defaultVal=emptyInt) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) if (sum(p%Nslip) > 0_pInt) then - p%tau0_slip = phaseConfig(phase)%getFloatArray('tau0_slip') - p%tausat_slip = phaseConfig(phase)%getFloatArray('tausat_slip') - p%H_int = phaseConfig(phase)%getFloatArray('h_int',defaultVal=[(0.0_pReal,i=1_pInt,size(p%Nslip))]) - print*, (shape(p%H_int)) - print*, (shape(p%Nslip)) + p%tau0_slip = phaseConfig(phase)%getFloatArray('tau0_slip') + p%tausat_slip = phaseConfig(phase)%getFloatArray('tausat_slip') p%interaction_SlipSlip = phaseConfig(phase)%getFloatArray('interaction_slipslip') + p%H_int = phaseConfig(phase)%getFloatArray('h_int',& + defaultVal=[(0.0_pReal,i=1_pInt,size(p%Nslip))]) p%nonSchmidCoeff = phaseConfig(phase)%getFloatArray('nonschmid_coefficients',& - defaultVal = [real(pReal)::1] ) - p%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') - p%n_slip = phaseConfig(phase)%getFloat('n_slip') - p%a_slip = phaseConfig(phase)%getFloat('a_slip') - p%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') + defaultVal = [real(pReal)::1] ) + + p%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') + p%n_slip = phaseConfig(phase)%getFloat('n_slip') + p%a_slip = phaseConfig(phase)%getFloat('a_slip') + p%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') endif p%Ntwin = phaseConfig(phase)%getIntArray('ntwin', defaultVal=emptyInt) @@ -209,15 +201,17 @@ subroutine plastic_phenopowerlaw_init if (sum(p%Ntwin) > 0_pInt) then p%tau0_twin = phaseConfig(phase)%getFloatArray('tau0_twin') p%interaction_TwinTwin = phaseConfig(phase)%getFloatArray('interaction_twintwin') - p%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') - p%n_twin = phaseConfig(phase)%getFloat('n_twin') - p%spr = phaseConfig(phase)%getFloat('s_pr') - p%twinB = phaseConfig(phase)%getFloat('twin_b') - p%twinC = phaseConfig(phase)%getFloat('twin_c') - p%twinD = phaseConfig(phase)%getFloat('twin_d') - p%twinE = phaseConfig(phase)%getFloat('twin_e') - p%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') - endif + + p%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') + p%n_twin = phaseConfig(phase)%getFloat('n_twin') + p%spr = phaseConfig(phase)%getFloat('s_pr') + p%twinB = phaseConfig(phase)%getFloat('twin_b') + p%twinC = phaseConfig(phase)%getFloat('twin_c') + p%twinD = phaseConfig(phase)%getFloat('twin_d') + p%twinE = phaseConfig(phase)%getFloat('twin_e') + p%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') + endif + if (sum(p%Nslip) > 0_pInt .and. sum(p%Ntwin) > 0_pInt) then p%interaction_SlipTwin = phaseConfig(phase)%getFloatArray('interaction_sliptwin') p%interaction_TwinSlip = phaseConfig(phase)%getFloatArray('interaction_twinslip') @@ -228,9 +222,11 @@ subroutine plastic_phenopowerlaw_init allocate(p%matrix_SlipTwin(sum(p%Nslip),sum(p%Ntwin)),source =0.0_pReal) allocate(p%matrix_TwinSlip(sum(p%Ntwin),sum(p%Nslip)),source =0.0_pReal) allocate(p%matrix_TwinTwin(sum(p%Ntwin),sum(p%Ntwin)),source =0.0_pReal) - p%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) - p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - p%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + + p%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) + p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + p%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + outputs = phaseConfig(phase)%getStrings('(output)') allocate(p%outputID(0)) do i=1_pInt, size(outputs) @@ -280,21 +276,21 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip/twin systems -extmsg = '' -if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " -if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " -if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " -if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " - if (extmsg /= '') call IO_error(211_pInt,ip=instance,& - ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') - -if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tau0_slip' " -if (any(p%tau0_slip < p%tausat_slip .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tausat_slip' " -if (any(p%gdot0_slip <= 0.0_pReal .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tausat_slip' " -if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " + extmsg = '' + if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " + if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " + if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " + if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " + if (extmsg /= '') call IO_error(211_pInt,ip=instance,& + ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') + + if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tau0_slip' " + if (any(p%tau0_slip < p%tausat_slip .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tausat_slip' " + if (any(p%gdot0_slip <= 0.0_pReal .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tausat_slip' " + if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " !if (any(dEq0(p%a_slip) .and. sum(p%Nslip) > 0)) & ! call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') @@ -317,21 +313,16 @@ if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') - - - NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase - !-------------------------------------------------------------------------------------------------- ! allocate state arrays + NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase sizeState = size(['tau_slip ','accshear_slip']) * sum(p%nslip) & + size(['tau_twin ','accshear_twin']) * sum(p%ntwin) & + size(['sum(gamma)', 'sum(f) ']) sizeDotState = sizeState - sizeDeltaState = 0_pInt plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState plasticState(phase)%nSlip = sum(p%Nslip) plasticState(phase)%nTwin = sum(p%Ntwin) allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) @@ -339,8 +330,9 @@ if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (0_pInt,NipcMyPhase), source=0.0_pReal) if (any(numerics_integrator == 1_pInt)) then allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) @@ -350,12 +342,6 @@ if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " if (any(numerics_integrator == 5_pInt)) & allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) - offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt - plasticState(phase)%slipRate => & - plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - !-------------------------------------------------------------------------------------------------- ! calculate hardening matrices mySlipFamilies: do f = 1_pInt,size(p%Nslip,1) ! >>> interaction slip -- X @@ -455,6 +441,12 @@ if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear + offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt + plasticState(phase)%slipRate => & + plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + plasticState(phase)%accumulatedSlip => & + plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + endif enddo From 11383a2aca5005e082287a52d420835f91e8602c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 10:19:22 +0200 Subject: [PATCH 015/208] proper error checks --- src/plastic_phenopowerlaw.f90 | 67 ++++++++++++++++------------------- 1 file changed, 30 insertions(+), 37 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index a06a31a88..156fe29d0 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -272,46 +272,40 @@ subroutine plastic_phenopowerlaw_init p%outputID = [p%outputID , outputID] endif - end do + end do -!-------------------------------------------------------------------------------------------------- -! parameters independent of number of slip/twin systems - extmsg = '' - if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " - if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " - if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " - if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " - if (extmsg /= '') call IO_error(211_pInt,ip=instance,& - ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') - - if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tau0_slip' " - if (any(p%tau0_slip < p%tausat_slip .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tausat_slip' " - if (any(p%gdot0_slip <= 0.0_pReal .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tausat_slip' " - if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " + extmsg = '' + if (sum(p%Nslip) > 0_pInt) then + if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " + if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " + if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " - !if (any(dEq0(p%a_slip) .and. sum(p%Nslip) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tau0_slip' " + if (any(p%tausat_slip < p%tau0_slip .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tausat_slip' " - ! if (any(p%tau0_twin < 0.0_pReal .and. & - ! p%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - ! if ( p%gdot0_twin <= 0.0_pReal .and. & - ! any(p%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - ! if ( p%n_twin <= 0.0_pReal .and. & - ! any(p%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (p%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_slip' " + if (dEq0(p%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? + if (dEq0(p%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? + endif - if (p%aTolResistance <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolResistance ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (p%aTolShear <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolShear ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (p%aTolTwinfrac <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (sum(p%Ntwin) > 0_pInt) then + if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " + if (any(p%tau0_twin < 0.0_pReal .and. p%Ntwin > 0_pInt)) & + extmsg = trim(extmsg)//" 'tau0_twin' " + + if (p%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_twin' " + if (dEq0(p%n_twin)) extmsg = trim(extmsg)//" n_twin " ! ToDo: negative values ok? + endif + + if (p%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolresistance' " + if (p%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolShear' " + if (p%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//" 'atoltwinfrac' " + + if (extmsg /= '') call IO_error(211_pInt,ip=instance,& + ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') !-------------------------------------------------------------------------------------------------- ! allocate state arrays @@ -471,8 +465,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, lattice_maxNslipFamily, & lattice_maxNtwinFamily, & lattice_NslipSystem, & - lattice_NtwinSystem, & - lattice_NnonSchmid + lattice_NtwinSystem use material, only: & phaseAt, phasememberAt, & phase_plasticityInstance From 8aeb4a115ef455d5935a9b0b3d2428d014c3c4bc Mon Sep 17 00:00:00 2001 From: Jaeyong Jung Date: Mon, 18 Jun 2018 16:19:03 +0200 Subject: [PATCH 016/208] first commit. --- src/spectral_interface.f90 | 140 ++++++++++++++++++++++++++++++++++++- 1 file changed, 137 insertions(+), 3 deletions(-) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index d2adcf9ba..9b1808e0f 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -195,9 +195,17 @@ subroutine DAMASK_interface_init() call quit(1_pInt) endif - workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg),trim(geometryArg))) - geometryFile = getGeometryFile(geometryArg) - loadCaseFile = getLoadCaseFile(loadCaseArg) +! workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg),trim(geometryArg))) +! geometryFile = getGeometryFile(geometryArg) +! loadCaseFile = getLoadCaseFile(loadCaseArg) + + workingDirectory = trim(storeWorkingDirectory2(trim(workingDirArg),trim(geometryArg))) + geometryFile = getGeometryFile2(geometryArg,workingDirectory) + loadCaseFile = getLoadCaseFile2(loadCaseArg,workingDirectory) + + +! write(*,*) trim(workingDirectory) +! write(*,*) trim(workingDirectory)//'/' ! put '/' next to workingDirectory call get_environment_variable('USER',userName) error = getHostName(hostName) @@ -216,9 +224,135 @@ subroutine DAMASK_interface_init() write(6,'(a,i6.6)') ' Restart from increment: ', spectralRestartInc write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile + read(*,*) + end subroutine DAMASK_interface_init + +!-------------------------------------------------------------------------------------------------- +!> @brief extract working directory from given argument or from location of geometry file, +!! possibly converting relative arguments to absolut path +!> @todo change working directory with call chdir(storeWorkingDirectory)? +!-------------------------------------------------------------------------------------------------- +character(len=1024) function storeWorkingDirectory2(workingDirectoryArg,geometryArg) + use system_routines, only: & + isDirectory, & + getCWD + + implicit none + character(len=*), intent(in) :: workingDirectoryArg !< working directory argument + character(len=*), intent(in) :: geometryArg !< geometry argument + character(len=1024) :: cwd + logical :: error + external :: quit + + wdGiven: if (len(workingDirectoryArg)>0) then !< -d is given + absolutePath: if (workingDirectoryArg(1:1) == '/') then !< absolute path is given to workingDirectoryArg + storeWorkingDirectory2 = workingDirectoryArg + else absolutePath !< relative path is given + error = getCWD(cwd) + if (error) call quit(1_pInt) + storeWorkingDirectory2 = trim(cwd)//'/'//workingDirectoryArg !< add relative path to cwd + endif absolutePath + if (storeWorkingDirectory2(len(trim(storeWorkingDirectory2)):len(trim(storeWorkingDirectory2))) /= '/') & + storeWorkingDirectory2 = trim(storeWorkingDirectory2)//'/' ! if path seperator is not given, append it + else wdGiven !< -d is not given + error = getCWD(cwd) + if (error) call quit(1_pInt) + storeWorkingDirectory2 = trim(cwd)//'/' + +! if (geometryArg(1:1) == '/') then ! absolute path given as command line argument +! storeWorkingDirectory2 = geometryArg(1:scan(geometryArg,'/',back=.true.)) +! else +! error = getCWD(cwd) ! relative path given as command line argument +! if (error) call quit(1_pInt) +! storeWorkingDirectory2 = trim(cwd)//'/'//geometryArg(1:scan(geometryArg,'/',back=.true.)) !< workingDirectory should not depend on geometryArg +! endif + endif wdGiven + + storeWorkingDirectory2 = trim(rectifyPath(storeWorkingDirectory2)) + if(.not. isDirectory(trim(storeWorkingDirectory2))) then ! check if the directory exists + write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory2),'" does not exist' + call quit(1_pInt) + endif + +end function storeWorkingDirectory2 + + + +!-------------------------------------------------------------------------------------------------- +!> @brief basename of geometry file with extension from command line arguments +!-------------------------------------------------------------------------------------------------- +character(len=1024) function getGeometryFile2(geometryParameter,workingDirectory) + use system_routines, only: & + getCWD + + implicit none + character(len=1024), intent(in) :: & + geometryParameter + character(len=*), intent(in) :: workingDirectory !< working directory +! character(len=1024) :: & +! cwd + integer :: posExt, posSep + logical :: error + external :: quit + + getGeometryFile2 = geometryParameter + posExt = scan(getGeometryFile2,'.',back=.true.) + posSep = scan(getGeometryFile2,'/',back=.true.) + + if (posExt <= posSep) getGeometryFile2 = trim(getGeometryFile2)//('.geom') ! no extension present + if (scan(getGeometryFile2,'/') /= 1) then ! relative path given as command line argument +! error = getcwd(cwd) ! no more cwd +! cwd = workingDirectory + if (error) call quit(1_pInt) + getGeometryFile2 = rectifyPath(trim(workingDirectory)//'/'//getGeometryFile2) + else + getGeometryFile2 = rectifyPath(getGeometryFile2) + endif + + getGeometryFile2 = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile2) + +end function getGeometryFile2 + + +!-------------------------------------------------------------------------------------------------- +!> @brief relative path of loadcase from command line arguments +!-------------------------------------------------------------------------------------------------- +character(len=1024) function getLoadCaseFile2(loadCaseParameter,workingDirectory) + use system_routines, only: & + getCWD + + implicit none + character(len=1024), intent(in) :: & + loadCaseParameter + character(len=*), intent(in) :: workingDirectory !< working directory +! character(len=1024) :: & +! cwd + integer :: posExt, posSep + logical :: error + external :: quit + + getLoadCaseFile2 = loadcaseParameter + posExt = scan(getLoadCaseFile2,'.',back=.true.) + posSep = scan(getLoadCaseFile2,'/',back=.true.) + + if (posExt <= posSep) getLoadCaseFile2 = trim(getLoadCaseFile2)//('.load') ! no extension present + if (scan(getLoadCaseFile2,'/') /= 1) then ! relative path given as command line argument +! error = getcwd(cwd) +! cwd = workingDirectory + if (error) call quit(1_pInt) + getLoadCaseFile2 = rectifyPath(trim(workingDirectory)//'/'//getLoadCaseFile2) + else + getLoadCaseFile2 = rectifyPath(getLoadCaseFile2) + endif + + getLoadCaseFile2 = makeRelativePath(getSolverWorkingDirectoryName(), getLoadCaseFile2) + +end function getLoadCaseFile2 + + !-------------------------------------------------------------------------------------------------- !> @brief extract working directory from given argument or from location of geometry file, !! possibly converting relative arguments to absolut path From 13f280367e65027ef6fce4058741132a0b4b39d8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 19:43:41 +0200 Subject: [PATCH 017/208] using config module --- src/linked_list.f90 | 2 +- src/plastic_phenopowerlaw.f90 | 207 +++++++++++++++++----------------- 2 files changed, 105 insertions(+), 104 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index 6826a26da..142528fa1 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -431,7 +431,7 @@ function getFloats(this,key,defaultVal) real(pReal), dimension(:), allocatable :: getFloats class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key - integer(pInt), dimension(:), intent(in), optional :: defaultVal + real(pReal), dimension(:), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: item integer(pInt) :: i logical :: found, & diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 7800feb22..b5ddcc187 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -130,7 +130,8 @@ subroutine plastic_phenopowerlaw_init material_phase, & plasticState use config, only: & - MATERIAL_partPhase + MATERIAL_partPhase, & + phaseConfig use lattice use numerics,only: & numerics_integrator @@ -148,7 +149,7 @@ subroutine plastic_phenopowerlaw_init integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] - type(tParameters), pointer :: p + type(tParameters), pointer :: prm integer(kind(undefined_ID)) :: & outputID !< ID of each post result output @@ -176,86 +177,86 @@ subroutine plastic_phenopowerlaw_init do phase = 1_pInt, size(phase_plasticityInstance) if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then instance = phase_plasticityInstance(phase) - p => param(instance) + prm => param(instance) - p%Nslip = phaseConfig(phase)%getIntArray('nslip',defaultVal=emptyInt) + prm%Nslip = phaseConfig(phase)%getInts('nslip',defaultVal=emptyInt) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - if (sum(p%Nslip) > 0_pInt) then - p%tau0_slip = phaseConfig(phase)%getFloatArray('tau0_slip') - p%tausat_slip = phaseConfig(phase)%getFloatArray('tausat_slip') - p%interaction_SlipSlip = phaseConfig(phase)%getFloatArray('interaction_slipslip') - p%H_int = phaseConfig(phase)%getFloatArray('h_int',& - defaultVal=[(0.0_pReal,i=1_pInt,size(p%Nslip))]) - p%nonSchmidCoeff = phaseConfig(phase)%getFloatArray('nonschmid_coefficients',& + if (sum(prm%Nslip) > 0_pInt) then + prm%tau0_slip = phaseConfig(phase)%getFloats('tau0_slip') + prm%tausat_slip = phaseConfig(phase)%getFloats('tausat_slip') + prm%interaction_SlipSlip = phaseConfig(phase)%getFloats('interaction_slipslip') + prm%H_int = phaseConfig(phase)%getFloats('h_int',& + defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%nonSchmidCoeff = phaseConfig(phase)%getFloats('nonschmid_coefficients',& defaultVal = [real(pReal)::1] ) - p%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') - p%n_slip = phaseConfig(phase)%getFloat('n_slip') - p%a_slip = phaseConfig(phase)%getFloat('a_slip') - p%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') + prm%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') + prm%n_slip = phaseConfig(phase)%getFloat('n_slip') + prm%a_slip = phaseConfig(phase)%getFloat('a_slip') + prm%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') endif - p%Ntwin = phaseConfig(phase)%getIntArray('ntwin', defaultVal=emptyInt) + prm%Ntwin = phaseConfig(phase)%getInts('ntwin', defaultVal=emptyInt) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - if (sum(p%Ntwin) > 0_pInt) then - p%tau0_twin = phaseConfig(phase)%getFloatArray('tau0_twin') - p%interaction_TwinTwin = phaseConfig(phase)%getFloatArray('interaction_twintwin') + if (sum(prm%Ntwin) > 0_pInt) then + prm%tau0_twin = phaseConfig(phase)%getFloats('tau0_twin') + prm%interaction_TwinTwin = phaseConfig(phase)%getFloats('interaction_twintwin') - p%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') - p%n_twin = phaseConfig(phase)%getFloat('n_twin') - p%spr = phaseConfig(phase)%getFloat('s_pr') - p%twinB = phaseConfig(phase)%getFloat('twin_b') - p%twinC = phaseConfig(phase)%getFloat('twin_c') - p%twinD = phaseConfig(phase)%getFloat('twin_d') - p%twinE = phaseConfig(phase)%getFloat('twin_e') - p%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') + prm%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') + prm%n_twin = phaseConfig(phase)%getFloat('n_twin') + prm%spr = phaseConfig(phase)%getFloat('s_pr') + prm%twinB = phaseConfig(phase)%getFloat('twin_b') + prm%twinC = phaseConfig(phase)%getFloat('twin_c') + prm%twinD = phaseConfig(phase)%getFloat('twin_d') + prm%twinE = phaseConfig(phase)%getFloat('twin_e') + prm%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') endif - if (sum(p%Nslip) > 0_pInt .and. sum(p%Ntwin) > 0_pInt) then - p%interaction_SlipTwin = phaseConfig(phase)%getFloatArray('interaction_sliptwin') - p%interaction_TwinSlip = phaseConfig(phase)%getFloatArray('interaction_twinslip') - p%h0_TwinSlip = phaseConfig(phase)%getFloat('h0_twinslip') + if (sum(prm%Nslip) > 0_pInt .and. sum(prm%Ntwin) > 0_pInt) then + prm%interaction_SlipTwin = phaseConfig(phase)%getFloats('interaction_sliptwin') + prm%interaction_TwinSlip = phaseConfig(phase)%getFloats('interaction_twinslip') + prm%h0_TwinSlip = phaseConfig(phase)%getFloat('h0_twinslip') endif - allocate(p%matrix_SlipSlip(sum(p%Nslip),sum(p%Nslip)),source =0.0_pReal) - allocate(p%matrix_SlipTwin(sum(p%Nslip),sum(p%Ntwin)),source =0.0_pReal) - allocate(p%matrix_TwinSlip(sum(p%Ntwin),sum(p%Nslip)),source =0.0_pReal) - allocate(p%matrix_TwinTwin(sum(p%Ntwin),sum(p%Ntwin)),source =0.0_pReal) + allocate(prm%matrix_SlipSlip(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) + allocate(prm%matrix_SlipTwin(sum(prm%Nslip),sum(prm%Ntwin)),source =0.0_pReal) + allocate(prm%matrix_TwinSlip(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) + allocate(prm%matrix_TwinTwin(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) - p%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) - p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - p%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + prm%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) + prm%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + prm%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) outputs = phaseConfig(phase)%getStrings('(output)') - allocate(p%outputID(0)) + allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID select case(outputs(i)) case ('resistance_slip') outputID = resistance_slip_ID - outputSize = sum(p%Nslip) + outputSize = sum(prm%Nslip) case ('acumulatedshear_slip','accumulated_shear_slip') outputID = accumulatedshear_slip_ID - outputSize = sum(p%Nslip) + outputSize = sum(prm%Nslip) case ('shearrate_slip') outputID = shearrate_slip_ID - outputSize = sum(p%Nslip) + outputSize = sum(prm%Nslip) case ('resolvedstress_slip') outputID = resolvedstress_slip_ID - outputSize = sum(p%Nslip) + outputSize = sum(prm%Nslip) case ('resistance_twin') outputID = resistance_twin_ID - outputSize = sum(p%Ntwin) + outputSize = sum(prm%Ntwin) case ('accumulatedshear_twin','accumulated_shear_twin') outputID = accumulatedshear_twin_ID - outputSize = sum(p%Ntwin) + outputSize = sum(prm%Ntwin) case ('shearrate_twin') outputID = shearrate_twin_ID - outputSize = sum(p%Ntwin) + outputSize = sum(prm%Ntwin) case ('resolvedstress_twin') outputID = resolvedstress_twin_ID - outputSize = sum(p%Ntwin) + outputSize = sum(prm%Ntwin) case ('totalvolfrac_twin') outputID = totalvolfrac_twin_ID @@ -268,40 +269,40 @@ subroutine plastic_phenopowerlaw_init if (outputID /= undefined_ID) then plastic_phenopowerlaw_output(i,instance) = outputs(i) plastic_phenopowerlaw_sizePostResult(i,instance) = outputSize - p%outputID = [p%outputID , outputID] + prm%outputID = [prm%outputID , outputID] endif end do extmsg = '' - if (sum(p%Nslip) > 0_pInt) then - if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " - if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " - if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " + if (sum(prm%Nslip) > 0_pInt) then + if (size(prm%tau0_slip) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " + if (size(prm%tausat_slip) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " + if (size(prm%H_int) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(h_int) " - if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & + if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & extmsg = trim(extmsg)//" 'tau0_slip' " - if (any(p%tausat_slip < p%tau0_slip .and. p%Nslip > 0_pInt)) & + if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & extmsg = trim(extmsg)//" 'tausat_slip' " - if (p%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_slip' " - if (dEq0(p%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? - if (dEq0(p%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? + if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_slip' " + if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? + if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? endif - if (sum(p%Ntwin) > 0_pInt) then - if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " + if (sum(prm%Ntwin) > 0_pInt) then + if (size(prm%tau0_twin) /= size(prm%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " - if (any(p%tau0_twin < 0.0_pReal .and. p%Ntwin > 0_pInt)) & + if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & extmsg = trim(extmsg)//" 'tau0_twin' " - if (p%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_twin' " - if (dEq0(p%n_twin)) extmsg = trim(extmsg)//" n_twin " ! ToDo: negative values ok? + if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_twin' " + if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//" n_twin " ! ToDo: negative values ok? endif - if (p%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolresistance' " - if (p%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolShear' " - if (p%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//" 'atoltwinfrac' " + if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolresistance' " + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolShear' " + if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//" 'atoltwinfrac' " if (extmsg /= '') call IO_error(211_pInt,ip=instance,& ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') @@ -309,15 +310,15 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase - sizeState = size(['tau_slip ','accshear_slip']) * sum(p%nslip) & - + size(['tau_twin ','accshear_twin']) * sum(p%ntwin) & + sizeState = size(['tau_slip ','accshear_slip']) * sum(prm%nslip) & + + size(['tau_twin ','accshear_twin']) * sum(prm%ntwin) & + size(['sum(gamma)', 'sum(f) ']) sizeDotState = sizeState plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%nSlip = sum(p%Nslip) - plasticState(phase)%nTwin = sum(p%Ntwin) + plasticState(phase)%nSlip = sum(prm%Nslip) + plasticState(phase)%nTwin = sum(prm%Ntwin) allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) @@ -337,25 +338,25 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! calculate hardening matrices - mySlipFamilies: do f = 1_pInt,size(p%Nslip,1) ! >>> interaction slip -- X - index_myFamily = sum(p%Nslip(1:f-1_pInt)) + mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) ! >>> interaction slip -- X + index_myFamily = sum(prm%Nslip(1:f-1_pInt)) - mySlipSystems: do j = 1_pInt,p%Nslip(f) - otherSlipFamilies: do o = 1_pInt,size(p%Nslip,1) - index_otherFamily = sum(p%Nslip(1:o-1_pInt)) - otherSlipSystems: do k = 1_pInt,p%Nslip(o) - p%matrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & - p%interaction_SlipSlip(lattice_interactionSlipSlip( & + mySlipSystems: do j = 1_pInt,prm%Nslip(f) + otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + otherSlipSystems: do k = 1_pInt,prm%Nslip(o) + prm%matrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_SlipSlip(lattice_interactionSlipSlip( & sum(lattice_NslipSystem(1:f-1,phase))+j, & sum(lattice_NslipSystem(1:o-1,phase))+k, & phase)) enddo otherSlipSystems; enddo otherSlipFamilies - twinFamilies: do o = 1_pInt,size(p%Ntwin,1) - index_otherFamily = sum(p%Ntwin(1:o-1_pInt)) - twinSystems: do k = 1_pInt,p%Ntwin(o) - p%matrix_SlipTwin(index_myFamily+j,index_otherFamily+k) = & - p%interaction_SlipTwin(lattice_interactionSlipTwin( & + twinFamilies: do o = 1_pInt,size(prm%Ntwin,1) + index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) + twinSystems: do k = 1_pInt,prm%Ntwin(o) + prm%matrix_SlipTwin(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_SlipTwin(lattice_interactionSlipTwin( & sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & phase)) @@ -363,24 +364,24 @@ subroutine plastic_phenopowerlaw_init enddo mySlipSystems enddo mySlipFamilies - myTwinFamilies: do f = 1_pInt,size(p%Ntwin,1) ! >>> interaction twin -- X - index_myFamily = sum(p%Ntwin(1:f-1_pInt)) - myTwinSystems: do j = 1_pInt,p%Ntwin(f) - slipFamilies: do o = 1_pInt,size(p%Nslip,1) - index_otherFamily = sum(p%Nslip(1:o-1_pInt)) - slipSystems: do k = 1_pInt,p%Nslip(o) - p%matrix_TwinSlip(index_myFamily+j,index_otherFamily+k) = & - p%interaction_TwinSlip(lattice_interactionTwinSlip( & + myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X + index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) + myTwinSystems: do j = 1_pInt,prm%Ntwin(f) + slipFamilies: do o = 1_pInt,size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + slipSystems: do k = 1_pInt,prm%Nslip(o) + prm%matrix_TwinSlip(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_TwinSlip(lattice_interactionTwinSlip( & sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & phase)) enddo slipSystems; enddo slipFamilies - otherTwinFamilies: do o = 1_pInt,size(p%Ntwin,1) - index_otherFamily = sum(p%Ntwin(1:o-1_pInt)) - otherTwinSystems: do k = 1_pInt,p%Ntwin(o) - p%matrix_TwinTwin(index_myFamily+j,index_otherFamily+k) = & - p%interaction_TwinTwin(lattice_interactionTwinTwin( & + otherTwinFamilies: do o = 1_pInt,size(prm%Ntwin,1) + index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) + otherTwinSystems: do k = 1_pInt,prm%Ntwin(o) + prm%matrix_TwinTwin(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_TwinTwin(lattice_interactionTwinTwin( & sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & phase)) @@ -395,35 +396,35 @@ subroutine plastic_phenopowerlaw_init state (instance)%s_slip=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%s_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%state0(startIndex:endIndex,:) = & - spread(math_expand(p%tau0_slip, p%Nslip), 2, NipcMyPhase) + spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolResistance + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + plasticState(phase)%nTwin state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%state0(startIndex:endIndex,:) = & - spread(math_expand(p%tau0_twin, p%Ntwin), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolResistance + spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumGamma=>plasticState(phase)%state (startIndex,:) dotState(instance)%sumGamma=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumF=>plasticState(phase)%state (startIndex,:) dotState(instance)%sumF=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolTwinFrac + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac startIndex = endIndex + 1_pInt endIndex = endIndex + plasticState(phase)%nSlip state (instance)%accshear_slip=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear ! global alias plasticState(phase)%slipRate =>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%accumulatedSlip =>plasticState(phase)%state(startIndex:endIndex,:) @@ -432,7 +433,7 @@ subroutine plastic_phenopowerlaw_init endIndex = endIndex + plasticState(phase)%nTwin state (instance)%accshear_twin=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt plasticState(phase)%slipRate => & From 7ccca899c6ad4813fc8062e5675de5f71d8d5eb9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 23:36:46 +0200 Subject: [PATCH 018/208] using branch 19 counterpart in PRIVATE to adjust parameter names --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index aead92902..89246b5ee 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit aead92902b3a0cf3404be9c552bfec918d7aaffb +Subproject commit 89246b5ee30a850a52df020c4770b685568ccbc2 From 0f3485c4a124e34ad3c869770f2214f0deeceae6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Jun 2018 23:14:30 +0200 Subject: [PATCH 019/208] using default value for when getting strings, setting correct size for post results --- src/plastic_phenopowerlaw.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index b5ddcc187..79aac355e 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -1,5 +1,6 @@ !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief material subroutine for phenomenological crystal plasticity formulation using a powerlaw !! fitting !-------------------------------------------------------------------------------------------------- @@ -227,7 +228,7 @@ subroutine plastic_phenopowerlaw_init prm%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) prm%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) - outputs = phaseConfig(phase)%getStrings('(output)') + outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=[character(len=65536)::]) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID @@ -317,6 +318,7 @@ subroutine plastic_phenopowerlaw_init sizeDotState = sizeState plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) plasticState(phase)%nSlip = sum(prm%Nslip) plasticState(phase)%nTwin = sum(prm%Ntwin) allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) From 74aec7bb71ec831ab02d3074376ac4369b4ab242 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Jun 2018 18:14:14 +0200 Subject: [PATCH 020/208] circumventing bug in Gfortran, tests use correct label (a_slip) --- PRIVATE | 2 +- src/plastic_phenopowerlaw.f90 | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index 89246b5ee..99433c5ca 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 89246b5ee30a850a52df020c4770b685568ccbc2 +Subproject commit 99433c5cadc8d568b94282834ce80ffc960fbed8 diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 79aac355e..4ee6cb3c9 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -157,7 +157,7 @@ subroutine plastic_phenopowerlaw_init character(len=512) :: & extmsg = '' - character(len=64), dimension(:), allocatable :: outputs + character(len=65536), dimension(:), allocatable :: outputs write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -228,7 +228,13 @@ subroutine plastic_phenopowerlaw_init prm%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) prm%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) +#if defined(__GFORTRAN__) + outputs = ['GfortranBug86277'] + outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=outputs) + if (outputs(1) == 'GfortranBug86277') outputs = [character(len=65536)::] +#else outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=[character(len=65536)::]) +#endif allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID From bd09bd91f911b1df3485b4dc4804db2b5e2f4049 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 23 Jun 2018 14:48:32 +0200 Subject: [PATCH 021/208] exit immediately if array size does not match Nslip/Ntwin otherwise, array acces out of bounds might happen for subsequent sanity checks --- src/plastic_phenopowerlaw.f90 | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 4ee6cb3c9..6979187ed 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -283,33 +283,37 @@ subroutine plastic_phenopowerlaw_init extmsg = '' if (sum(prm%Nslip) > 0_pInt) then - if (size(prm%tau0_slip) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " - if (size(prm%tausat_slip) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " - if (size(prm%H_int) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(h_int) " + if (size(prm%tau0_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(tau0_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (size(prm%tausat_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(tausat_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (size(prm%H_int) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(H_int) ('//PLASTICITY_PHENOPOWERLAW_label//')') if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tau0_slip' " + extmsg = trim(extmsg)//"tau0_slip " if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tausat_slip' " + extmsg = trim(extmsg)//"tausat_slip " - if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_slip' " + if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" gdot0_slip " if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? endif if (sum(prm%Ntwin) > 0_pInt) then - if (size(prm%tau0_twin) /= size(prm%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " + if (size(prm%tau0_twin) /= size(prm%ntwin)) call IO_error(211_pInt,ip=instance,& + ext_msg='shape(tau0_twin) ('//PLASTICITY_PHENOPOWERLAW_label//')') if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & - extmsg = trim(extmsg)//" 'tau0_twin' " + extmsg = trim(extmsg)//"tau0_twin " - if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_twin' " - if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//" n_twin " ! ToDo: negative values ok? + if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_twin " + if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//"n_twin " ! ToDo: negative values ok? endif - if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolresistance' " - if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolShear' " - if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//" 'atoltwinfrac' " + if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//"aTolresistance " + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"aTolShear " + if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//"atoltwinfrac " if (extmsg /= '') call IO_error(211_pInt,ip=instance,& ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') From d484d1b5bb919f8d58ec300f1c82e9398b7f439f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 25 Jun 2018 10:33:22 +0200 Subject: [PATCH 022/208] fixed typo and removed alias --- src/plastic_phenopowerlaw.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 6979187ed..d888e6c09 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -242,7 +242,7 @@ subroutine plastic_phenopowerlaw_init case ('resistance_slip') outputID = resistance_slip_ID outputSize = sum(prm%Nslip) - case ('acumulatedshear_slip','accumulated_shear_slip') + case ('accumulatedshear_slip') outputID = accumulatedshear_slip_ID outputSize = sum(prm%Nslip) case ('shearrate_slip') @@ -255,7 +255,7 @@ subroutine plastic_phenopowerlaw_init case ('resistance_twin') outputID = resistance_twin_ID outputSize = sum(prm%Ntwin) - case ('accumulatedshear_twin','accumulated_shear_twin') + case ('accumulatedshear_twin') outputID = accumulatedshear_twin_ID outputSize = sum(prm%Ntwin) case ('shearrate_twin') From feb69782556b8e963445fdd05dfb5a94e8ec07bd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 25 Jun 2018 10:33:36 +0200 Subject: [PATCH 023/208] test was broken --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 99433c5ca..c9eed7180 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 99433c5cadc8d568b94282834ce80ffc960fbed8 +Subproject commit c9eed718041d098d7695871c1b123eae950b141d From f63e8fe34ecd88c72c9bc2d1b3e7d6cb258cf6e5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 25 Jun 2018 13:43:34 +0200 Subject: [PATCH 024/208] avoid specifying per-family-values for inactive families --- PRIVATE | 2 +- lib/damask/config/material.py | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index c9eed7180..d8ab8056d 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c9eed718041d098d7695871c1b123eae950b141d +Subproject commit d8ab8056d6245ce42bec8953de9af1d7754867cf diff --git a/lib/damask/config/material.py b/lib/damask/config/material.py index a56c5d976..b070e986f 100644 --- a/lib/damask/config/material.py +++ b/lib/damask/config/material.py @@ -267,3 +267,14 @@ class Material(): if newlen is not oldlen: print('Length of value was changed from %i to %i!'%(oldlen,newlen)) + def add_value(self, part=None, + section=None, + key=None, + value=None): + if not isinstance(value,list): + if not isinstance(value,str): + value = '%s'%value + value = [value] + print('adding %s:%s:%s with value %s '%(part.lower(),section.lower(),key.lower(),value)) + self.data[part.lower()][section.lower()][key.lower()] = value + self.data[part.lower()][section.lower()]['__order__'] += [key.lower()] From 6cd08a38b17c7e660fd4aeec24ed4a7796d3ba7d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 25 Jun 2018 14:06:13 +0200 Subject: [PATCH 025/208] pre-defined variables seem to work for gfortran --- src/plastic_phenopowerlaw.f90 | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index d888e6c09..fe79f9ae8 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -149,6 +149,7 @@ subroutine plastic_phenopowerlaw_init integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] + character(len=65536), dimension(0), parameter :: emptyString = [character(len=65536)::] type(tParameters), pointer :: prm @@ -189,7 +190,7 @@ subroutine plastic_phenopowerlaw_init prm%H_int = phaseConfig(phase)%getFloats('h_int',& defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) prm%nonSchmidCoeff = phaseConfig(phase)%getFloats('nonschmid_coefficients',& - defaultVal = [real(pReal)::1] ) + defaultVal = emptyReal ) prm%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') prm%n_slip = phaseConfig(phase)%getFloat('n_slip') @@ -228,13 +229,7 @@ subroutine plastic_phenopowerlaw_init prm%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) prm%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) -#if defined(__GFORTRAN__) - outputs = ['GfortranBug86277'] - outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=outputs) - if (outputs(1) == 'GfortranBug86277') outputs = [character(len=65536)::] -#else - outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=[character(len=65536)::]) -#endif + outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=emptyString) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID @@ -615,8 +610,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) lattice_maxNtwinFamily, & lattice_NslipSystem, & lattice_NtwinSystem, & - lattice_shearTwin, & - lattice_NnonSchmid + lattice_shearTwin use material, only: & material_phase, & phaseAt, phasememberAt, & @@ -686,7 +680,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ! Calculation of dot gamma tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) + nonSchmidSystems: do k = 1,size(param(instance)%nonSchmidCoeff) tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) tau_slip_neg = tau_slip_neg +param(instance)%nonSchmidCoeff(k)* & From a8c69dfcadcbe3aa433364b011251e9c8f68dbb1 Mon Sep 17 00:00:00 2001 From: Jaeyong Jung Date: Tue, 26 Jun 2018 16:09:37 +0200 Subject: [PATCH 026/208] commit spectral_interface --- src/spectral_interface.f90 | 165 ++++--------------------------------- 1 file changed, 15 insertions(+), 150 deletions(-) mode change 100644 => 100755 src/spectral_interface.f90 diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 old mode 100644 new mode 100755 index 9b1808e0f..41d62a3a9 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -195,17 +195,9 @@ subroutine DAMASK_interface_init() call quit(1_pInt) endif -! workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg),trim(geometryArg))) -! geometryFile = getGeometryFile(geometryArg) -! loadCaseFile = getLoadCaseFile(loadCaseArg) - - workingDirectory = trim(storeWorkingDirectory2(trim(workingDirArg),trim(geometryArg))) - geometryFile = getGeometryFile2(geometryArg,workingDirectory) - loadCaseFile = getLoadCaseFile2(loadCaseArg,workingDirectory) - - -! write(*,*) trim(workingDirectory) -! write(*,*) trim(workingDirectory)//'/' ! put '/' next to workingDirectory + workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg))) + geometryFile = getGeometryFile(geometryArg) + loadCaseFile = getLoadCaseFile(loadCaseArg) call get_environment_variable('USER',userName) error = getHostName(hostName) @@ -224,148 +216,21 @@ subroutine DAMASK_interface_init() write(6,'(a,i6.6)') ' Restart from increment: ', spectralRestartInc write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile - read(*,*) - end subroutine DAMASK_interface_init - !-------------------------------------------------------------------------------------------------- !> @brief extract working directory from given argument or from location of geometry file, !! possibly converting relative arguments to absolut path !> @todo change working directory with call chdir(storeWorkingDirectory)? !-------------------------------------------------------------------------------------------------- -character(len=1024) function storeWorkingDirectory2(workingDirectoryArg,geometryArg) +character(len=1024) function storeWorkingDirectory(workingDirectoryArg) use system_routines, only: & isDirectory, & getCWD implicit none character(len=*), intent(in) :: workingDirectoryArg !< working directory argument - character(len=*), intent(in) :: geometryArg !< geometry argument - character(len=1024) :: cwd - logical :: error - external :: quit - - wdGiven: if (len(workingDirectoryArg)>0) then !< -d is given - absolutePath: if (workingDirectoryArg(1:1) == '/') then !< absolute path is given to workingDirectoryArg - storeWorkingDirectory2 = workingDirectoryArg - else absolutePath !< relative path is given - error = getCWD(cwd) - if (error) call quit(1_pInt) - storeWorkingDirectory2 = trim(cwd)//'/'//workingDirectoryArg !< add relative path to cwd - endif absolutePath - if (storeWorkingDirectory2(len(trim(storeWorkingDirectory2)):len(trim(storeWorkingDirectory2))) /= '/') & - storeWorkingDirectory2 = trim(storeWorkingDirectory2)//'/' ! if path seperator is not given, append it - else wdGiven !< -d is not given - error = getCWD(cwd) - if (error) call quit(1_pInt) - storeWorkingDirectory2 = trim(cwd)//'/' - -! if (geometryArg(1:1) == '/') then ! absolute path given as command line argument -! storeWorkingDirectory2 = geometryArg(1:scan(geometryArg,'/',back=.true.)) -! else -! error = getCWD(cwd) ! relative path given as command line argument -! if (error) call quit(1_pInt) -! storeWorkingDirectory2 = trim(cwd)//'/'//geometryArg(1:scan(geometryArg,'/',back=.true.)) !< workingDirectory should not depend on geometryArg -! endif - endif wdGiven - - storeWorkingDirectory2 = trim(rectifyPath(storeWorkingDirectory2)) - if(.not. isDirectory(trim(storeWorkingDirectory2))) then ! check if the directory exists - write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory2),'" does not exist' - call quit(1_pInt) - endif - -end function storeWorkingDirectory2 - - - -!-------------------------------------------------------------------------------------------------- -!> @brief basename of geometry file with extension from command line arguments -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getGeometryFile2(geometryParameter,workingDirectory) - use system_routines, only: & - getCWD - - implicit none - character(len=1024), intent(in) :: & - geometryParameter - character(len=*), intent(in) :: workingDirectory !< working directory -! character(len=1024) :: & -! cwd - integer :: posExt, posSep - logical :: error - external :: quit - - getGeometryFile2 = geometryParameter - posExt = scan(getGeometryFile2,'.',back=.true.) - posSep = scan(getGeometryFile2,'/',back=.true.) - - if (posExt <= posSep) getGeometryFile2 = trim(getGeometryFile2)//('.geom') ! no extension present - if (scan(getGeometryFile2,'/') /= 1) then ! relative path given as command line argument -! error = getcwd(cwd) ! no more cwd -! cwd = workingDirectory - if (error) call quit(1_pInt) - getGeometryFile2 = rectifyPath(trim(workingDirectory)//'/'//getGeometryFile2) - else - getGeometryFile2 = rectifyPath(getGeometryFile2) - endif - - getGeometryFile2 = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile2) - -end function getGeometryFile2 - - -!-------------------------------------------------------------------------------------------------- -!> @brief relative path of loadcase from command line arguments -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getLoadCaseFile2(loadCaseParameter,workingDirectory) - use system_routines, only: & - getCWD - - implicit none - character(len=1024), intent(in) :: & - loadCaseParameter - character(len=*), intent(in) :: workingDirectory !< working directory -! character(len=1024) :: & -! cwd - integer :: posExt, posSep - logical :: error - external :: quit - - getLoadCaseFile2 = loadcaseParameter - posExt = scan(getLoadCaseFile2,'.',back=.true.) - posSep = scan(getLoadCaseFile2,'/',back=.true.) - - if (posExt <= posSep) getLoadCaseFile2 = trim(getLoadCaseFile2)//('.load') ! no extension present - if (scan(getLoadCaseFile2,'/') /= 1) then ! relative path given as command line argument -! error = getcwd(cwd) -! cwd = workingDirectory - if (error) call quit(1_pInt) - getLoadCaseFile2 = rectifyPath(trim(workingDirectory)//'/'//getLoadCaseFile2) - else - getLoadCaseFile2 = rectifyPath(getLoadCaseFile2) - endif - - getLoadCaseFile2 = makeRelativePath(getSolverWorkingDirectoryName(), getLoadCaseFile2) - -end function getLoadCaseFile2 - - -!-------------------------------------------------------------------------------------------------- -!> @brief extract working directory from given argument or from location of geometry file, -!! possibly converting relative arguments to absolut path -!> @todo change working directory with call chdir(storeWorkingDirectory)? -!-------------------------------------------------------------------------------------------------- -character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryArg) - use system_routines, only: & - isDirectory, & - getCWD - - implicit none - character(len=*), intent(in) :: workingDirectoryArg !< working directory argument - character(len=*), intent(in) :: geometryArg !< geometry argument character(len=1024) :: cwd logical :: error external :: quit @@ -381,13 +246,9 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= '/') & storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it else wdGiven - if (geometryArg(1:1) == '/') then ! absolute path given as command line argument - storeWorkingDirectory = geometryArg(1:scan(geometryArg,'/',back=.true.)) - else error = getCWD(cwd) ! relative path given as command line argument if (error) call quit(1_pInt) - storeWorkingDirectory = trim(cwd)//'/'//geometryArg(1:scan(geometryArg,'/',back=.true.)) - endif + storeWorkingDirectory = trim(cwd)//'/' endif wdGiven storeWorkingDirectory = trim(rectifyPath(storeWorkingDirectory)) @@ -458,12 +319,15 @@ character(len=1024) function getGeometryFile(geometryParameter) if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present if (scan(getGeometryFile,'/') /= 1) then ! relative path given as command line argument - error = getcwd(cwd) - if (error) call quit(1_pInt) - getGeometryFile = rectifyPath(trim(cwd)//'/'//getGeometryFile) +! error = getcwd(cwd) +! if (error) call quit(1_pInt) +! getGeometryFile = rectifyPath(trim(workingDirectory)//'/'//getGeometryFile) + getGeometryFile = rectifyPath(trim(getSolverWorkingDirectoryName())//trim(getGeometryFile)) else getGeometryFile = rectifyPath(getGeometryFile) endif + write(*,*) 'getsolv.. ', (getSolverWorkingDirectoryName()) + write(*,*) 'getGeometryFile.. ', (getGeometryFile) getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile) @@ -492,9 +356,10 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present if (scan(getLoadCaseFile,'/') /= 1) then ! relative path given as command line argument - error = getcwd(cwd) - if (error) call quit(1_pInt) - getLoadCaseFile = rectifyPath(trim(cwd)//'/'//getLoadCaseFile) +! error = getcwd(cwd) +! if (error) call quit(1_pInt) +! getLoadCaseFile = rectifyPath(trim(workingDirectory)//'/'//getLoadCaseFile) + getLoadCaseFile = rectifyPath(trim(getSolverWorkingDirectoryName())//trim(getLoadCaseFile)) else getLoadCaseFile = rectifyPath(getLoadCaseFile) endif From 96e5175f41a28d81bb836a45a1cf0b168dbb5327 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 21:08:13 +0200 Subject: [PATCH 027/208] updated rename --- src/plastic_phenopowerlaw.f90 | 58 +++++++++++++++++------------------ 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index fe79f9ae8..9e03d8737 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -132,7 +132,7 @@ subroutine plastic_phenopowerlaw_init plasticState use config, only: & MATERIAL_partPhase, & - phaseConfig + config_phase use lattice use numerics,only: & numerics_integrator @@ -181,43 +181,43 @@ subroutine plastic_phenopowerlaw_init instance = phase_plasticityInstance(phase) prm => param(instance) - prm%Nslip = phaseConfig(phase)%getInts('nslip',defaultVal=emptyInt) + prm%Nslip = config_phase(phase)%getInts('nslip',defaultVal=emptyInt) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) if (sum(prm%Nslip) > 0_pInt) then - prm%tau0_slip = phaseConfig(phase)%getFloats('tau0_slip') - prm%tausat_slip = phaseConfig(phase)%getFloats('tausat_slip') - prm%interaction_SlipSlip = phaseConfig(phase)%getFloats('interaction_slipslip') - prm%H_int = phaseConfig(phase)%getFloats('h_int',& + prm%tau0_slip = config_phase(phase)%getFloats('tau0_slip') + prm%tausat_slip = config_phase(phase)%getFloats('tausat_slip') + prm%interaction_SlipSlip = config_phase(phase)%getFloats('interaction_slipslip') + prm%H_int = config_phase(phase)%getFloats('h_int',& defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%nonSchmidCoeff = phaseConfig(phase)%getFloats('nonschmid_coefficients',& + prm%nonSchmidCoeff = config_phase(phase)%getFloats('nonschmid_coefficients',& defaultVal = emptyReal ) - prm%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') - prm%n_slip = phaseConfig(phase)%getFloat('n_slip') - prm%a_slip = phaseConfig(phase)%getFloat('a_slip') - prm%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') + prm%gdot0_slip = config_phase(phase)%getFloat('gdot0_slip') + prm%n_slip = config_phase(phase)%getFloat('n_slip') + prm%a_slip = config_phase(phase)%getFloat('a_slip') + prm%h0_SlipSlip = config_phase(phase)%getFloat('h0_slipslip') endif - prm%Ntwin = phaseConfig(phase)%getInts('ntwin', defaultVal=emptyInt) + prm%Ntwin = config_phase(phase)%getInts('ntwin', defaultVal=emptyInt) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) if (sum(prm%Ntwin) > 0_pInt) then - prm%tau0_twin = phaseConfig(phase)%getFloats('tau0_twin') - prm%interaction_TwinTwin = phaseConfig(phase)%getFloats('interaction_twintwin') + prm%tau0_twin = config_phase(phase)%getFloats('tau0_twin') + prm%interaction_TwinTwin = config_phase(phase)%getFloats('interaction_twintwin') - prm%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') - prm%n_twin = phaseConfig(phase)%getFloat('n_twin') - prm%spr = phaseConfig(phase)%getFloat('s_pr') - prm%twinB = phaseConfig(phase)%getFloat('twin_b') - prm%twinC = phaseConfig(phase)%getFloat('twin_c') - prm%twinD = phaseConfig(phase)%getFloat('twin_d') - prm%twinE = phaseConfig(phase)%getFloat('twin_e') - prm%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') + prm%gdot0_twin = config_phase(phase)%getFloat('gdot0_twin') + prm%n_twin = config_phase(phase)%getFloat('n_twin') + prm%spr = config_phase(phase)%getFloat('s_pr') + prm%twinB = config_phase(phase)%getFloat('twin_b') + prm%twinC = config_phase(phase)%getFloat('twin_c') + prm%twinD = config_phase(phase)%getFloat('twin_d') + prm%twinE = config_phase(phase)%getFloat('twin_e') + prm%h0_TwinTwin = config_phase(phase)%getFloat('h0_twintwin') endif if (sum(prm%Nslip) > 0_pInt .and. sum(prm%Ntwin) > 0_pInt) then - prm%interaction_SlipTwin = phaseConfig(phase)%getFloats('interaction_sliptwin') - prm%interaction_TwinSlip = phaseConfig(phase)%getFloats('interaction_twinslip') - prm%h0_TwinSlip = phaseConfig(phase)%getFloat('h0_twinslip') + prm%interaction_SlipTwin = config_phase(phase)%getFloats('interaction_sliptwin') + prm%interaction_TwinSlip = config_phase(phase)%getFloats('interaction_twinslip') + prm%h0_TwinSlip = config_phase(phase)%getFloat('h0_twinslip') endif allocate(prm%matrix_SlipSlip(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) @@ -225,11 +225,11 @@ subroutine plastic_phenopowerlaw_init allocate(prm%matrix_TwinSlip(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) allocate(prm%matrix_TwinTwin(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) - prm%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) - prm%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - prm%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + prm%aTolResistance = config_phase(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) + prm%aTolShear = config_phase(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + prm%aTolTwinfrac = config_phase(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) - outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=emptyString) + outputs = config_phase(phase)%getStrings('(output)',defaultVal=emptyString) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID From 00f34363dc4c3707b22bae24b756f6ab5771fc71 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 27 Jun 2018 09:12:33 +0200 Subject: [PATCH 028/208] adjusted naming convention --- src/plastic_phenopowerlaw.f90 | 192 +++++++++++++++++----------------- 1 file changed, 96 insertions(+), 96 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 9e03d8737..0b7efd472 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -141,15 +141,15 @@ subroutine plastic_phenopowerlaw_init integer(pInt) :: & maxNinstance, & - instance,phase,j,k, f,o, i,& + instance,p,j,k, f,o, i,& NipcMyPhase, outputSize, & offset_slip, index_myFamily, index_otherFamily, & sizeState,sizeDotState, & startIndex, endIndex - integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] - real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] - character(len=65536), dimension(0), parameter :: emptyString = [character(len=65536)::] + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] + real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] type(tParameters), pointer :: prm @@ -176,48 +176,48 @@ subroutine plastic_phenopowerlaw_init allocate(state(maxNinstance)) allocate(dotState(maxNinstance)) - do phase = 1_pInt, size(phase_plasticityInstance) - if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then - instance = phase_plasticityInstance(phase) + do p = 1_pInt, size(phase_plasticityInstance) + if (phase_plasticity(p) == PLASTICITY_PHENOPOWERLAW_ID) then + instance = phase_plasticityInstance(p) prm => param(instance) - prm%Nslip = config_phase(phase)%getInts('nslip',defaultVal=emptyInt) + prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) if (sum(prm%Nslip) > 0_pInt) then - prm%tau0_slip = config_phase(phase)%getFloats('tau0_slip') - prm%tausat_slip = config_phase(phase)%getFloats('tausat_slip') - prm%interaction_SlipSlip = config_phase(phase)%getFloats('interaction_slipslip') - prm%H_int = config_phase(phase)%getFloats('h_int',& + prm%tau0_slip = config_phase(p)%getFloats('tau0_slip') + prm%tausat_slip = config_phase(p)%getFloats('tausat_slip') + prm%interaction_SlipSlip = config_phase(p)%getFloats('interaction_slipslip') + prm%H_int = config_phase(p)%getFloats('h_int',& defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%nonSchmidCoeff = config_phase(phase)%getFloats('nonschmid_coefficients',& - defaultVal = emptyReal ) + prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray ) - prm%gdot0_slip = config_phase(phase)%getFloat('gdot0_slip') - prm%n_slip = config_phase(phase)%getFloat('n_slip') - prm%a_slip = config_phase(phase)%getFloat('a_slip') - prm%h0_SlipSlip = config_phase(phase)%getFloat('h0_slipslip') + prm%gdot0_slip = config_phase(p)%getFloat('gdot0_slip') + prm%n_slip = config_phase(p)%getFloat('n_slip') + prm%a_slip = config_phase(p)%getFloat('a_slip') + prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip') endif - prm%Ntwin = config_phase(phase)%getInts('ntwin', defaultVal=emptyInt) + prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) if (sum(prm%Ntwin) > 0_pInt) then - prm%tau0_twin = config_phase(phase)%getFloats('tau0_twin') - prm%interaction_TwinTwin = config_phase(phase)%getFloats('interaction_twintwin') + prm%tau0_twin = config_phase(p)%getFloats('tau0_twin') + prm%interaction_TwinTwin = config_phase(p)%getFloats('interaction_twintwin') - prm%gdot0_twin = config_phase(phase)%getFloat('gdot0_twin') - prm%n_twin = config_phase(phase)%getFloat('n_twin') - prm%spr = config_phase(phase)%getFloat('s_pr') - prm%twinB = config_phase(phase)%getFloat('twin_b') - prm%twinC = config_phase(phase)%getFloat('twin_c') - prm%twinD = config_phase(phase)%getFloat('twin_d') - prm%twinE = config_phase(phase)%getFloat('twin_e') - prm%h0_TwinTwin = config_phase(phase)%getFloat('h0_twintwin') + prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin') + prm%n_twin = config_phase(p)%getFloat('n_twin') + prm%spr = config_phase(p)%getFloat('s_pr') + prm%twinB = config_phase(p)%getFloat('twin_b') + prm%twinC = config_phase(p)%getFloat('twin_c') + prm%twinD = config_phase(p)%getFloat('twin_d') + prm%twinE = config_phase(p)%getFloat('twin_e') + prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin') endif if (sum(prm%Nslip) > 0_pInt .and. sum(prm%Ntwin) > 0_pInt) then - prm%interaction_SlipTwin = config_phase(phase)%getFloats('interaction_sliptwin') - prm%interaction_TwinSlip = config_phase(phase)%getFloats('interaction_twinslip') - prm%h0_TwinSlip = config_phase(phase)%getFloat('h0_twinslip') + prm%interaction_SlipTwin = config_phase(p)%getFloats('interaction_sliptwin') + prm%interaction_TwinSlip = config_phase(p)%getFloats('interaction_twinslip') + prm%h0_TwinSlip = config_phase(p)%getFloat('h0_twinslip') endif allocate(prm%matrix_SlipSlip(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) @@ -225,11 +225,11 @@ subroutine plastic_phenopowerlaw_init allocate(prm%matrix_TwinSlip(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) allocate(prm%matrix_TwinTwin(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) - prm%aTolResistance = config_phase(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) - prm%aTolShear = config_phase(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - prm%aTolTwinfrac = config_phase(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal) + prm%aTolShear = config_phase(p)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) - outputs = config_phase(phase)%getStrings('(output)',defaultVal=emptyString) + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID @@ -315,33 +315,33 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase + NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase sizeState = size(['tau_slip ','accshear_slip']) * sum(prm%nslip) & + size(['tau_twin ','accshear_twin']) * sum(prm%ntwin) & + size(['sum(gamma)', 'sum(f) ']) sizeDotState = sizeState - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) - plasticState(phase)%nSlip = sum(prm%Nslip) - plasticState(phase)%nTwin = sum(prm%Ntwin) - allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) - allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + plasticState(p)%sizeState = sizeState + plasticState(p)%sizeDotState = sizeDotState + plasticState(p)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) + plasticState(p)%nSlip = sum(prm%Nslip) + plasticState(p)%nTwin = sum(prm%Ntwin) + allocate(plasticState(p)%aTolState ( sizeState), source=0.0_pReal) + allocate(plasticState(p)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%state ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (0_pInt,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%deltaState (0_pInt,NipcMyPhase), source=0.0_pReal) if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(p)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(p)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) endif if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) !-------------------------------------------------------------------------------------------------- ! calculate hardening matrices @@ -354,9 +354,9 @@ subroutine plastic_phenopowerlaw_init otherSlipSystems: do k = 1_pInt,prm%Nslip(o) prm%matrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & prm%interaction_SlipSlip(lattice_interactionSlipSlip( & - sum(lattice_NslipSystem(1:f-1,phase))+j, & - sum(lattice_NslipSystem(1:o-1,phase))+k, & - phase)) + sum(lattice_NslipSystem(1:f-1,p))+j, & + sum(lattice_NslipSystem(1:o-1,p))+k, & + p)) enddo otherSlipSystems; enddo otherSlipFamilies twinFamilies: do o = 1_pInt,size(prm%Ntwin,1) @@ -364,9 +364,9 @@ subroutine plastic_phenopowerlaw_init twinSystems: do k = 1_pInt,prm%Ntwin(o) prm%matrix_SlipTwin(index_myFamily+j,index_otherFamily+k) = & prm%interaction_SlipTwin(lattice_interactionSlipTwin( & - sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & - phase)) + sum(lattice_NslipSystem(1:f-1_pInt,p))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & + p)) enddo twinSystems; enddo twinFamilies enddo mySlipSystems enddo mySlipFamilies @@ -379,9 +379,9 @@ subroutine plastic_phenopowerlaw_init slipSystems: do k = 1_pInt,prm%Nslip(o) prm%matrix_TwinSlip(index_myFamily+j,index_otherFamily+k) = & prm%interaction_TwinSlip(lattice_interactionTwinSlip( & - sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & - phase)) + sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,p))+k, & + p)) enddo slipSystems; enddo slipFamilies otherTwinFamilies: do o = 1_pInt,size(prm%Ntwin,1) @@ -389,9 +389,9 @@ subroutine plastic_phenopowerlaw_init otherTwinSystems: do k = 1_pInt,prm%Ntwin(o) prm%matrix_TwinTwin(index_myFamily+j,index_otherFamily+k) = & prm%interaction_TwinTwin(lattice_interactionTwinTwin( & - sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & - phase)) + sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & + p)) enddo otherTwinSystems; enddo otherTwinFamilies enddo myTwinSystems enddo myTwinFamilies @@ -399,54 +399,54 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState startIndex = 1_pInt - endIndex = plasticState(phase)%nSlip - state (instance)%s_slip=>plasticState(phase)%state (startIndex:endIndex,:) - dotState(instance)%s_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%state0(startIndex:endIndex,:) = & + endIndex = plasticState(p)%nSlip + state (instance)%s_slip=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%state0(startIndex:endIndex,:) = & spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolResistance + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(phase)%nTwin - state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) - dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%state0(startIndex:endIndex,:) = & + endIndex = endIndex + plasticState(p)%nTwin + state (instance)%s_twin=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%state0(startIndex:endIndex,:) = & spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolResistance + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt - state (instance)%sumGamma=>plasticState(phase)%state (startIndex,:) - dotState(instance)%sumGamma=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear + state (instance)%sumGamma=>plasticState(p)%state (startIndex,:) + dotState(instance)%sumGamma=>plasticState(p)%dotState(startIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt - state (instance)%sumF=>plasticState(phase)%state (startIndex,:) - dotState(instance)%sumF=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac + state (instance)%sumF=>plasticState(p)%state (startIndex,:) + dotState(instance)%sumF=>plasticState(p)%dotState(startIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(phase)%nSlip - state (instance)%accshear_slip=>plasticState(phase)%state (startIndex:endIndex,:) - dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear + endIndex = endIndex + plasticState(p)%nSlip + state (instance)%accshear_slip=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear ! global alias - plasticState(phase)%slipRate =>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%accumulatedSlip =>plasticState(phase)%state(startIndex:endIndex,:) + plasticState(p)%slipRate =>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%accumulatedSlip =>plasticState(p)%state(startIndex:endIndex,:) startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(phase)%nTwin - state (instance)%accshear_twin=>plasticState(phase)%state (startIndex:endIndex,:) - dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear + endIndex = endIndex + plasticState(p)%nTwin + state (instance)%accshear_twin=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt - plasticState(phase)%slipRate => & - plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + offset_slip = plasticState(p)%nSlip+plasticState(p)%nTwin+2_pInt + plasticState(p)%slipRate => & + plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) + plasticState(p)%accumulatedSlip => & + plasticState(p)%state(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) endif enddo From ddf7584f4d58b5368b462a1f3663209884131d4c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 27 Jun 2018 10:01:36 +0200 Subject: [PATCH 029/208] following ideas implemented by Philip in disloUCLA prm and stt are pointers to instance of parameter and state interaction_xxYY is a matrix, gets shape assigned during calculation totalNslip and totalNslip are defined as derived parameter --- src/plastic_phenopowerlaw.f90 | 634 +++++++++++++++++----------------- 1 file changed, 322 insertions(+), 312 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 0b7efd472..e8e092807 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -32,6 +32,9 @@ module plastic_phenopowerlaw end enum type, private :: tParameters !< container type for internal constitutive parameters + integer(pInt) :: & + totalNslip, & + totalNtwin real(pReal) :: & gdot0_slip, & !< reference shear strain rate for slip gdot0_twin, & !< reference shear strain rate for twin @@ -57,16 +60,12 @@ module plastic_phenopowerlaw tau0_twin, & !< initial critical shear stress for twin tausat_slip, & !< maximum critical shear stress for slip nonSchmidCoeff, & - H_int, & !< per family hardening activity (optional) + H_int !< per family hardening activity (optional) + real(pReal), dimension(:,:), allocatable :: & interaction_SlipSlip, & !< slip resistance from slip activity interaction_SlipTwin, & !< slip resistance from twin activity interaction_TwinSlip, & !< twin resistance from slip activity interaction_TwinTwin !< twin resistance from twin activity - real(pReal), dimension(:,:), allocatable :: & - matrix_SlipSlip, & !< slip resistance from slip activity - matrix_SlipTwin, & !< slip resistance from twin activity - matrix_TwinSlip, & !< twin resistance from slip activity - matrix_TwinTwin !< twin resistance from twin activity integer(kind(undefined_ID)), dimension(:), allocatable :: & outputID !< ID of each post result output @@ -85,7 +84,7 @@ module plastic_phenopowerlaw sumF end type - type(tPhenopowerlawState), allocatable, dimension(:), private :: & + type(tPhenopowerlawState), allocatable, dimension(:), target, private :: & dotState, & state @@ -147,6 +146,8 @@ subroutine plastic_phenopowerlaw_init sizeState,sizeDotState, & startIndex, endIndex + real(pReal), dimension(:,:), allocatable :: temp1, temp2 + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] @@ -177,278 +178,289 @@ subroutine plastic_phenopowerlaw_init allocate(dotState(maxNinstance)) do p = 1_pInt, size(phase_plasticityInstance) - if (phase_plasticity(p) == PLASTICITY_PHENOPOWERLAW_ID) then - instance = phase_plasticityInstance(p) - prm => param(instance) + if (phase_plasticity(p) /= PLASTICITY_PHENOPOWERLAW_ID) cycle + instance = phase_plasticityInstance(p) + prm => param(instance) - prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) - !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - if (sum(prm%Nslip) > 0_pInt) then - prm%tau0_slip = config_phase(p)%getFloats('tau0_slip') - prm%tausat_slip = config_phase(p)%getFloats('tausat_slip') - prm%interaction_SlipSlip = config_phase(p)%getFloats('interaction_slipslip') - prm%H_int = config_phase(p)%getFloats('h_int',& - defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',& - defaultVal = emptyRealArray ) + prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) + if (size(prm%Nslip) > count(lattice_NslipSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') + if (any(lattice_NslipSystem(1:size(prm%Nslip),p)-prm%Nslip < 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') + prm%totalNslip = sum(prm%Nslip) - prm%gdot0_slip = config_phase(p)%getFloat('gdot0_slip') - prm%n_slip = config_phase(p)%getFloat('n_slip') - prm%a_slip = config_phase(p)%getFloat('a_slip') - prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip') - endif + if (prm%totalNslip > 0_pInt) then + prm%tau0_slip = config_phase(p)%getFloats('tau0_slip') + prm%tausat_slip = config_phase(p)%getFloats('tausat_slip') + prm%interaction_SlipSlip = spread(config_phase(p)%getFloats('interaction_slipslip'),2,1) + prm%H_int = config_phase(p)%getFloats('h_int',& + defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray ) - prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) - !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - if (sum(prm%Ntwin) > 0_pInt) then - prm%tau0_twin = config_phase(p)%getFloats('tau0_twin') - prm%interaction_TwinTwin = config_phase(p)%getFloats('interaction_twintwin') + prm%gdot0_slip = config_phase(p)%getFloat('gdot0_slip') + prm%n_slip = config_phase(p)%getFloat('n_slip') + prm%a_slip = config_phase(p)%getFloat('a_slip') + prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip') + endif - prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin') - prm%n_twin = config_phase(p)%getFloat('n_twin') - prm%spr = config_phase(p)%getFloat('s_pr') - prm%twinB = config_phase(p)%getFloat('twin_b') - prm%twinC = config_phase(p)%getFloat('twin_c') - prm%twinD = config_phase(p)%getFloat('twin_d') - prm%twinE = config_phase(p)%getFloat('twin_e') - prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin') - endif + prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) + if (size(prm%Ntwin) > count(lattice_NtwinSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Ntwin') + if (any(lattice_NtwinSystem(1:size(prm%Ntwin),p)-prm%Ntwin < 0_pInt)) call IO_error(150_pInt,ext_msg='Ntwin') + prm%totalNtwin = sum(prm%Ntwin) - if (sum(prm%Nslip) > 0_pInt .and. sum(prm%Ntwin) > 0_pInt) then - prm%interaction_SlipTwin = config_phase(p)%getFloats('interaction_sliptwin') - prm%interaction_TwinSlip = config_phase(p)%getFloats('interaction_twinslip') - prm%h0_TwinSlip = config_phase(p)%getFloat('h0_twinslip') - endif + if (prm%totalNtwin > 0_pInt) then + prm%tau0_twin = config_phase(p)%getFloats('tau0_twin') + prm%interaction_TwinTwin = spread(config_phase(p)%getFloats('interaction_twintwin'),2,1) - allocate(prm%matrix_SlipSlip(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) - allocate(prm%matrix_SlipTwin(sum(prm%Nslip),sum(prm%Ntwin)),source =0.0_pReal) - allocate(prm%matrix_TwinSlip(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) - allocate(prm%matrix_TwinTwin(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) + prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin') + prm%n_twin = config_phase(p)%getFloat('n_twin') + prm%spr = config_phase(p)%getFloat('s_pr') + prm%twinB = config_phase(p)%getFloat('twin_b') + prm%twinC = config_phase(p)%getFloat('twin_c') + prm%twinD = config_phase(p)%getFloat('twin_d') + prm%twinE = config_phase(p)%getFloat('twin_e') + prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin') + endif - prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal) - prm%aTolShear = config_phase(p)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then + prm%interaction_SlipTwin = spread(config_phase(p)%getFloats('interaction_sliptwin'),2,1) + prm%interaction_TwinSlip = spread(config_phase(p)%getFloats('interaction_twinslip'),2,1) + prm%h0_TwinSlip = config_phase(p)%getFloat('h0_twinslip') + endif - outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) - allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) - outputID = undefined_ID - select case(outputs(i)) - case ('resistance_slip') - outputID = resistance_slip_ID - outputSize = sum(prm%Nslip) - case ('accumulatedshear_slip') - outputID = accumulatedshear_slip_ID - outputSize = sum(prm%Nslip) - case ('shearrate_slip') - outputID = shearrate_slip_ID - outputSize = sum(prm%Nslip) - case ('resolvedstress_slip') - outputID = resolvedstress_slip_ID - outputSize = sum(prm%Nslip) - case ('resistance_twin') - outputID = resistance_twin_ID - outputSize = sum(prm%Ntwin) - case ('accumulatedshear_twin') - outputID = accumulatedshear_twin_ID - outputSize = sum(prm%Ntwin) - case ('shearrate_twin') - outputID = shearrate_twin_ID - outputSize = sum(prm%Ntwin) - case ('resolvedstress_twin') - outputID = resolvedstress_twin_ID - outputSize = sum(prm%Ntwin) + prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal) + prm%aTolShear = config_phase(p)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) - case ('totalvolfrac_twin') - outputID = totalvolfrac_twin_ID - outputSize = 1_pInt - case ('totalshear') - outputID = totalshear_ID - outputSize = 1_pInt - end select + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + case ('resistance_slip') + outputID = resistance_slip_ID + outputSize = sum(prm%Nslip) + case ('accumulatedshear_slip') + outputID = accumulatedshear_slip_ID + outputSize = sum(prm%Nslip) + case ('shearrate_slip') + outputID = shearrate_slip_ID + outputSize = sum(prm%Nslip) + case ('resolvedstress_slip') + outputID = resolvedstress_slip_ID + outputSize = sum(prm%Nslip) - if (outputID /= undefined_ID) then - plastic_phenopowerlaw_output(i,instance) = outputs(i) - plastic_phenopowerlaw_sizePostResult(i,instance) = outputSize - prm%outputID = [prm%outputID , outputID] - endif + case ('resistance_twin') + outputID = resistance_twin_ID + outputSize = sum(prm%Ntwin) + case ('accumulatedshear_twin') + outputID = accumulatedshear_twin_ID + outputSize = sum(prm%Ntwin) + case ('shearrate_twin') + outputID = shearrate_twin_ID + outputSize = sum(prm%Ntwin) + case ('resolvedstress_twin') + outputID = resolvedstress_twin_ID + outputSize = sum(prm%Ntwin) - end do + case ('totalvolfrac_twin') + outputID = totalvolfrac_twin_ID + outputSize = 1_pInt + case ('totalshear') + outputID = totalshear_ID + outputSize = 1_pInt + end select - extmsg = '' - if (sum(prm%Nslip) > 0_pInt) then - if (size(prm%tau0_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & - ext_msg='shape(tau0_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (size(prm%tausat_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & - ext_msg='shape(tausat_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (size(prm%H_int) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & - ext_msg='shape(H_int) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (outputID /= undefined_ID) then + plastic_phenopowerlaw_output(i,instance) = outputs(i) + plastic_phenopowerlaw_sizePostResult(i,instance) = outputSize + prm%outputID = [prm%outputID , outputID] + endif - if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//"tau0_slip " - if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//"tausat_slip " + end do - if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" gdot0_slip " - if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? - if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? - endif + extmsg = '' + if (sum(prm%Nslip) > 0_pInt) then + if (size(prm%tau0_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(tau0_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (size(prm%tausat_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(tausat_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (size(prm%H_int) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(H_int) ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (sum(prm%Ntwin) > 0_pInt) then - if (size(prm%tau0_twin) /= size(prm%ntwin)) call IO_error(211_pInt,ip=instance,& - ext_msg='shape(tau0_twin) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//"tau0_slip " + if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//"tausat_slip " - if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & - extmsg = trim(extmsg)//"tau0_twin " + if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" gdot0_slip " + if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? + if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? + endif - if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_twin " - if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//"n_twin " ! ToDo: negative values ok? - endif + if (sum(prm%Ntwin) > 0_pInt) then + if (size(prm%tau0_twin) /= size(prm%ntwin)) call IO_error(211_pInt,ip=instance,& + ext_msg='shape(tau0_twin) ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//"aTolresistance " - if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"aTolShear " - if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//"atoltwinfrac " + if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & + extmsg = trim(extmsg)//"tau0_twin " - if (extmsg /= '') call IO_error(211_pInt,ip=instance,& - ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') + if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_twin " + if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//"n_twin " ! ToDo: negative values ok? + endif + + if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//"aTolresistance " + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"aTolShear " + if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//"atoltwinfrac " + + if (extmsg /= '') call IO_error(211_pInt,ip=instance,& + ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase - sizeState = size(['tau_slip ','accshear_slip']) * sum(prm%nslip) & - + size(['tau_twin ','accshear_twin']) * sum(prm%ntwin) & - + size(['sum(gamma)', 'sum(f) ']) + NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase + sizeState = size(['tau_slip ','accshear_slip']) * sum(prm%nslip) & + + size(['tau_twin ','accshear_twin']) * sum(prm%ntwin) & + + size(['sum(gamma)', 'sum(f) ']) - sizeDotState = sizeState - plasticState(p)%sizeState = sizeState - plasticState(p)%sizeDotState = sizeDotState - plasticState(p)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) - plasticState(p)%nSlip = sum(prm%Nslip) - plasticState(p)%nTwin = sum(prm%Ntwin) - allocate(plasticState(p)%aTolState ( sizeState), source=0.0_pReal) - allocate(plasticState(p)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(p)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(p)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(p)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + sizeDotState = sizeState + plasticState(p)%sizeState = sizeState + plasticState(p)%sizeDotState = sizeDotState + plasticState(p)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) + plasticState(p)%nSlip = sum(prm%Nslip) + plasticState(p)%nTwin = sum(prm%Ntwin) + allocate(plasticState(p)%aTolState ( sizeState), source=0.0_pReal) + allocate(plasticState(p)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + + allocate(plasticState(p)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%deltaState (0_pInt,NipcMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(p)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(p)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(p)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(p)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(p)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(p)%deltaState (0_pInt,NipcMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(p)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(p)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(p)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(p)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) !-------------------------------------------------------------------------------------------------- ! calculate hardening matrices - mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) ! >>> interaction slip -- X - index_myFamily = sum(prm%Nslip(1:f-1_pInt)) + allocate(temp1(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) + allocate(temp2(sum(prm%Nslip),sum(prm%Ntwin)),source =0.0_pReal) + mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) ! >>> interaction slip -- X + index_myFamily = sum(prm%Nslip(1:f-1_pInt)) - mySlipSystems: do j = 1_pInt,prm%Nslip(f) - otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) - index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) - otherSlipSystems: do k = 1_pInt,prm%Nslip(o) - prm%matrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_SlipSlip(lattice_interactionSlipSlip( & - sum(lattice_NslipSystem(1:f-1,p))+j, & - sum(lattice_NslipSystem(1:o-1,p))+k, & - p)) - enddo otherSlipSystems; enddo otherSlipFamilies + mySlipSystems: do j = 1_pInt,prm%Nslip(f) + otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + otherSlipSystems: do k = 1_pInt,prm%Nslip(o) + temp1(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_SlipSlip(lattice_interactionSlipSlip( & + sum(lattice_NslipSystem(1:f-1,p))+j, & + sum(lattice_NslipSystem(1:o-1,p))+k, & + p),1) + enddo otherSlipSystems; enddo otherSlipFamilies - twinFamilies: do o = 1_pInt,size(prm%Ntwin,1) - index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) - twinSystems: do k = 1_pInt,prm%Ntwin(o) - prm%matrix_SlipTwin(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_SlipTwin(lattice_interactionSlipTwin( & - sum(lattice_NslipSystem(1:f-1_pInt,p))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & - p)) - enddo twinSystems; enddo twinFamilies - enddo mySlipSystems - enddo mySlipFamilies + twinFamilies: do o = 1_pInt,size(prm%Ntwin,1) + index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) + twinSystems: do k = 1_pInt,prm%Ntwin(o) + temp2(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_SlipTwin(lattice_interactionSlipTwin( & + sum(lattice_NslipSystem(1:f-1_pInt,p))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & + p),1) + enddo twinSystems; enddo twinFamilies + enddo mySlipSystems + enddo mySlipFamilies + prm%interaction_SlipSlip = temp1; deallocate(temp1) + prm%interaction_SlipTwin = temp2; deallocate(temp2) + - myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X - index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) - myTwinSystems: do j = 1_pInt,prm%Ntwin(f) - slipFamilies: do o = 1_pInt,size(prm%Nslip,1) - index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) - slipSystems: do k = 1_pInt,prm%Nslip(o) - prm%matrix_TwinSlip(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_TwinSlip(lattice_interactionTwinSlip( & - sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & - sum(lattice_NslipSystem(1:o-1_pInt,p))+k, & - p)) - enddo slipSystems; enddo slipFamilies + allocate(temp1(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) + allocate(temp2(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) + myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X + index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) + myTwinSystems: do j = 1_pInt,prm%Ntwin(f) + slipFamilies: do o = 1_pInt,size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + slipSystems: do k = 1_pInt,prm%Nslip(o) + temp1(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_TwinSlip(lattice_interactionTwinSlip( & + sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,p))+k, & + p),1) + enddo slipSystems; enddo slipFamilies - otherTwinFamilies: do o = 1_pInt,size(prm%Ntwin,1) - index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) - otherTwinSystems: do k = 1_pInt,prm%Ntwin(o) - prm%matrix_TwinTwin(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_TwinTwin(lattice_interactionTwinTwin( & - sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & - p)) - enddo otherTwinSystems; enddo otherTwinFamilies - enddo myTwinSystems - enddo myTwinFamilies + otherTwinFamilies: do o = 1_pInt,size(prm%Ntwin,1) + index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) + otherTwinSystems: do k = 1_pInt,prm%Ntwin(o) + temp2(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_TwinTwin(lattice_interactionTwinTwin( & + sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & + p),1) + enddo otherTwinSystems; enddo otherTwinFamilies + enddo myTwinSystems + enddo myTwinFamilies + prm%interaction_TwinSlip = temp1; deallocate(temp1) + prm%interaction_TwinTwin = temp2; deallocate(temp2) !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState - startIndex = 1_pInt - endIndex = plasticState(p)%nSlip - state (instance)%s_slip=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%s_slip=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%state0(startIndex:endIndex,:) = & - spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) + startIndex = 1_pInt + endIndex = plasticState(p)%nSlip + state (instance)%s_slip=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%state0(startIndex:endIndex,:) = & + spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance - startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(p)%nTwin - state (instance)%s_twin=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%s_twin=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%state0(startIndex:endIndex,:) = & - spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance + startIndex = endIndex + 1_pInt + endIndex = endIndex + plasticState(p)%nTwin + state (instance)%s_twin=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%state0(startIndex:endIndex,:) = & + spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance - startIndex = endIndex + 1_pInt - endIndex = endIndex + 1_pInt - state (instance)%sumGamma=>plasticState(p)%state (startIndex,:) - dotState(instance)%sumGamma=>plasticState(p)%dotState(startIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear + startIndex = endIndex + 1_pInt + endIndex = endIndex + 1_pInt + state (instance)%sumGamma=>plasticState(p)%state (startIndex,:) + dotState(instance)%sumGamma=>plasticState(p)%dotState(startIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - startIndex = endIndex + 1_pInt - endIndex = endIndex + 1_pInt - state (instance)%sumF=>plasticState(p)%state (startIndex,:) - dotState(instance)%sumF=>plasticState(p)%dotState(startIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac + startIndex = endIndex + 1_pInt + endIndex = endIndex + 1_pInt + state (instance)%sumF=>plasticState(p)%state (startIndex,:) + dotState(instance)%sumF=>plasticState(p)%dotState(startIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac - startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(p)%nSlip - state (instance)%accshear_slip=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - ! global alias - plasticState(p)%slipRate =>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%accumulatedSlip =>plasticState(p)%state(startIndex:endIndex,:) + startIndex = endIndex + 1_pInt + endIndex = endIndex + plasticState(p)%nSlip + state (instance)%accshear_slip=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear + ! global alias + plasticState(p)%slipRate =>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%accumulatedSlip =>plasticState(p)%state(startIndex:endIndex,:) - startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(p)%nTwin - state (instance)%accshear_twin=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear + startIndex = endIndex + 1_pInt + endIndex = endIndex + plasticState(p)%nTwin + state (instance)%accshear_twin=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - offset_slip = plasticState(p)%nSlip+plasticState(p)%nTwin+2_pInt - plasticState(p)%slipRate => & - plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) - plasticState(p)%accumulatedSlip => & - plasticState(p)%state(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) + offset_slip = plasticState(p)%nSlip+plasticState(p)%nTwin+2_pInt + plasticState(p)%slipRate => & + plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) + plasticState(p)%accumulatedSlip => & + plasticState(p)%state(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) - endif enddo @@ -505,11 +517,14 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor real(pReal), dimension(3,3,2) :: & nonSchmid_tensor + type(tParameters), pointer :: prm of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) + prm => param(instance) + Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal dLp_dTstar99 = 0.0_pReal @@ -517,9 +532,9 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, !-------------------------------------------------------------------------------------------------- ! Slip part j = 0_pInt - slipFamilies: do f = 1_pInt,size(param(instance)%Nslip,1) + slipFamilies: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,param(instance)%Nslip(f) + slipSystems: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt ! Calculation of Lp @@ -527,30 +542,30 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, tau_slip_neg = tau_slip_pos nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) - do k = 1,size(param(instance)%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & + do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + param(instance)%nonSchmidCoeff(k)* & + tau_slip_neg = tau_slip_neg + prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + param(instance)%nonSchmidCoeff(k)*& + nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + prm%nonSchmidCoeff(k)*& lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + param(instance)%nonSchmidCoeff(k)*& + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + prm%nonSchmidCoeff(k)*& lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo - gdot_slip_pos = 0.5_pReal*param(instance)%gdot0_slip* & + gdot_slip_pos = 0.5_pReal*prm%gdot0_slip* & ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of))) & - **param(instance)%n_slip)*sign(1.0_pReal,tau_slip_pos) + **prm%n_slip)*sign(1.0_pReal,tau_slip_pos) - gdot_slip_neg = 0.5_pReal*param(instance)%gdot0_slip* & + gdot_slip_neg = 0.5_pReal*prm%gdot0_slip* & ((abs(tau_slip_neg)/(state(instance)%s_slip(j,of))) & - **param(instance)%n_slip)*sign(1.0_pReal,tau_slip_neg) + **prm%n_slip)*sign(1.0_pReal,tau_slip_neg) Lp = Lp + (1.0_pReal-state(instance)%sumF(of))*& ! 1-F (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! Calculation of the tangent of Lp if (dNeq0(gdot_slip_pos)) then - dgdot_dtauslip_pos = gdot_slip_pos*param(instance)%n_slip/tau_slip_pos + dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dgdot_dtauslip_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & @@ -558,7 +573,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, endif if (dNeq0(gdot_slip_neg)) then - dgdot_dtauslip_neg = gdot_slip_neg*param(instance)%n_slip/tau_slip_neg + dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dgdot_dtauslip_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & @@ -570,22 +585,22 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, !-------------------------------------------------------------------------------------------------- ! Twinning part j = 0_pInt - twinFamilies: do f = 1_pInt,size(param(instance)%Ntwin,1) + twinFamilies: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems: do i = 1_pInt,param(instance)%Ntwin(f) + twinSystems: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt ! Calculation of Lp tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) gdot_twin = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F - param(instance)%gdot0_twin*& + prm%gdot0_twin*& (abs(tau_twin)/state(instance)%s_twin(j,of))**& - param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) ! Calculation of the tangent of Lp if (dNeq0(gdot_twin)) then - dgdot_dtautwin = gdot_twin*param(instance)%n_twin/tau_twin + dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dgdot_dtautwin*lattice_Stwin(k,l,index_myFamily+i,ph)* & @@ -628,7 +643,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) integer(pInt) :: & instance,ph, & f,i,j,k, & - index_myFamily, nslip,ntwin,& + index_myFamily, & of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & @@ -639,67 +654,63 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Ntwin) :: & gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin + type(tParameters), pointer :: prm + type(tPhenopowerlawState), pointer :: stt of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) + prm => param(instance) + stt => state(instance) - nSlip= sum(param(instance)%nslip) - nTwin= sum(param(instance)%nTwin) plasticState(ph)%dotState(:,of) = 0.0_pReal !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices - c_SlipSlip = param(instance)%h0_slipslip*& - (1.0_pReal + param(instance)%twinC*state(instance)%sumF(of)**& - param(instance)%twinB) - c_TwinSlip = param(instance)%h0_TwinSlip*& - state(instance)%sumGamma(of)**param(instance)%twinE - c_TwinTwin = param(instance)%h0_TwinTwin*& - state(instance)%sumF(of)**param(instance)%twinD + c_SlipSlip = prm%h0_slipslip*(1.0_pReal + prm%twinC*stt%sumF(of)** prm%twinB) + c_TwinSlip = prm%h0_TwinSlip*stt%sumGamma(of)**prm%twinE + c_TwinTwin = prm%h0_TwinTwin*stt%sumF(of)**prm%twinD !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors and calculate dot gammas - ssat_offset = param(instance)%spr*sqrt(state(instance)%sumF(of)) + ssat_offset = prm%spr*sqrt(stt%sumF(of)) j = 0_pInt - slipFamilies1: do f =1_pInt,size(param(instance)%Nslip,1) + slipFamilies1: do f =1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,param(instance)%Nslip(f) + slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt - left_SlipSlip(j) = 1.0_pReal + param(instance)%H_int(f) ! modified no system-dependent left part + left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part - right_SlipSlip(j) = abs(1.0_pReal-state(instance)%s_slip(j,of) / & - (param(instance)%tausat_slip(f)+ssat_offset)) & - **param(instance)%a_slip& - *sign(1.0_pReal,1.0_pReal-state(instance)%s_slip(j,of) / & - (param(instance)%tausat_slip(f)+ssat_offset)) + right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / & + (prm%tausat_slip(f)+ssat_offset)) & + **prm%a_slip& + *sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / & + (prm%tausat_slip(f)+ssat_offset)) right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- ! Calculation of dot gamma tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,size(param(instance)%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & + nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg +param(instance)%nonSchmidCoeff(k)* & + tau_slip_neg = tau_slip_neg +prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems - gdot_slip(j) = param(instance)%gdot0_slip*0.5_pReal* & - ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & - *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & - *sign(1.0_pReal,tau_slip_neg)) + gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & + ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & + +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 j = 0_pInt - twinFamilies1: do f = 1_pInt,size(param(instance)%Ntwin,1) + twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,param(instance)%Ntwin(f) + twinSystems1: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt left_TwinSlip(j) = 1.0_pReal ! no system-dependent left part left_TwinTwin(j) = 1.0_pReal ! no system-dependent left part @@ -709,24 +720,24 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! Calculation of dot vol frac tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - gdot_twin(j) = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F - param(instance)%gdot0_twin*& - (abs(tau_twin)/state(instance)%s_twin(j,of))**& - param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + gdot_twin(j) = (1.0_pReal-stt%sumF(of))*& ! 1-F + prm%gdot0_twin*& + (abs(tau_twin)/stt%s_twin(j,of))**& + prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) enddo twinSystems1 enddo twinFamilies1 !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above j = 0_pInt - slipFamilies2: do f = 1_pInt,size(param(instance)%Nslip,1) - slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) + slipFamilies2: do f = 1_pInt,size(prm%Nslip,1) + slipSystems2: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt dotState(instance)%s_slip(j,of) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & - dot_product(param(instance)%matrix_SlipSlip(j,1:nslip), & + dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip), & right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(param(instance)%matrix_SlipTwin(j,1:ntwin), & + dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin), & right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + & abs(gdot_slip(j)) @@ -735,16 +746,16 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) enddo slipFamilies2 j = 0_pInt - twinFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) + twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,param(instance)%Ntwin(f) + twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j c_TwinSlip * left_TwinSlip(j) * & - dot_product(param(instance)%matrix_TwinSlip(j,1:nslip), & + dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip), & right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * left_TwinTwin(j) * & - dot_product(param(instance)%matrix_TwinTwin(j,1:ntwin), & + dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin), & right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (state(instance)%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 dotState(instance)%sumF(of) = dotState(instance)%sumF(of) + & @@ -787,18 +798,17 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) integer(pInt) :: & instance,ph, of, & - nSlip,nTwin, & o,f,i,c,j,k, & index_myFamily real(pReal) :: & tau_slip_pos,tau_slip_neg,tau + type(tParameters), pointer :: prm of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) + prm => param(instance) - nSlip= sum(param(instance)%nslip) - nTwin= sum(param(instance)%nTwin) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt @@ -806,12 +816,12 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) outputsLoop: do o = 1_pInt,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (resistance_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%s_slip(1:nSlip,of) - c = c + nSlip + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = state(instance)%s_slip(1:prm%totalNslip,of) + c = c + prm%totalNslip case (accumulatedshear_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%accshear_slip(1:nSlip,of) - c = c + nSlip + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = state(instance)%accshear_slip(1:prm%totalNslip,of) + c = c + prm%totalNslip case (shearrate_slip_ID) j = 0_pInt @@ -834,7 +844,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 - c = c + nSlip + c = c + prm%totalNslip case (resolvedstress_slip_ID) j = 0_pInt @@ -846,7 +856,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) enddo slipSystems2 enddo slipFamilies2 - c = c + nSlip + c = c + prm%totalNslip case (totalshear_ID) plastic_phenopowerlaw_postResults(c+1_pInt) = & @@ -854,14 +864,14 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + 1_pInt case (resistance_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state(instance)%s_twin(1:nTwin,of) - c = c + nTwin + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & + state(instance)%s_twin(1:prm%totalNtwin,of) + c = c + prm%totalNtwin case (accumulatedshear_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state(instance)%accshear_twin(1:nTwin,of) - c = c + nTwin + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & + state(instance)%accshear_twin(1:prm%totalNtwin,of) + c = c + prm%totalNtwin case (shearrate_twin_ID) j = 0_pInt twinFamilies1: do f = 1_pInt,size(param(instance)%Ntwin,1) @@ -875,7 +885,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) enddo twinSystems1 enddo twinFamilies1 - c = c + nTwin + c = c + prm%totalNtwin case (resolvedstress_twin_ID) j = 0_pInt @@ -887,7 +897,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) enddo twinSystems2 enddo twinFamilies2 - c = c + nTwin + c = c + prm%totalNtwin case (totalvolfrac_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt) = state(instance)%sumF(of) From 0f05565fd53ede29009b448f54debb27b23ce078 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 27 Jun 2018 10:09:19 +0200 Subject: [PATCH 030/208] don't complicate code with potential enhancements --- src/plastic_phenopowerlaw.f90 | 30 +++++++++--------------------- 1 file changed, 9 insertions(+), 21 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index e8e092807..3eba30606 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -319,8 +319,8 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase - sizeState = size(['tau_slip ','accshear_slip']) * sum(prm%nslip) & - + size(['tau_twin ','accshear_twin']) * sum(prm%ntwin) & + sizeState = size(['tau_slip ','accshear_slip']) * prm%TotalNslip & + + size(['tau_twin ','accshear_twin']) * prm%TotalNtwin & + size(['sum(gamma)', 'sum(f) ']) sizeDotState = sizeState @@ -651,9 +651,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) tau_slip_pos,tau_slip_neg,tau_twin real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Nslip) :: & - gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip + gdot_slip,left_SlipSlip,right_SlipSlip real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Ntwin) :: & - gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin + gdot_twin type(tParameters), pointer :: prm type(tPhenopowerlawState), pointer :: stt @@ -681,13 +681,11 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part - left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / & (prm%tausat_slip(f)+ssat_offset)) & **prm%a_slip& *sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / & (prm%tausat_slip(f)+ssat_offset)) - right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- ! Calculation of dot gamma @@ -712,10 +710,6 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystems1: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt - left_TwinSlip(j) = 1.0_pReal ! no system-dependent left part - left_TwinTwin(j) = 1.0_pReal ! no system-dependent left part - right_SlipTwin(j) = 1.0_pReal ! no system-dependent right part - right_TwinTwin(j) = 1.0_pReal ! no system-dependent right part !-------------------------------------------------------------------------------------------------- ! Calculation of dot vol frac @@ -735,10 +729,8 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) j = j+1_pInt dotState(instance)%s_slip(j,of) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & - dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip), & - right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin), & - right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor + dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + & abs(gdot_slip(j)) dotState(instance)%accshear_slip(j,of) = abs(gdot_slip(j)) @@ -750,13 +742,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt - dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j - c_TwinSlip * left_TwinSlip(j) * & - dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip), & - right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - c_TwinTwin * left_TwinTwin(j) * & - dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin), & - right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor + dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j + c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (state(instance)%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 dotState(instance)%sumF(of) = dotState(instance)%sumF(of) + & gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) From 49126d2f6f378ab3cd0b0c07e004ed8b324ca678 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 27 Jun 2018 10:19:50 +0200 Subject: [PATCH 031/208] further simplified --- src/plastic_phenopowerlaw.f90 | 60 ++++++++++++++++------------------- 1 file changed, 27 insertions(+), 33 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 3eba30606..ee0702215 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -668,9 +668,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices - c_SlipSlip = prm%h0_slipslip*(1.0_pReal + prm%twinC*stt%sumF(of)** prm%twinB) - c_TwinSlip = prm%h0_TwinSlip*stt%sumGamma(of)**prm%twinE - c_TwinTwin = prm%h0_TwinTwin*stt%sumF(of)**prm%twinD + c_SlipSlip = prm%h0_slipslip * (1.0_pReal + prm%twinC*stt%sumF(of)** prm%twinB) + c_TwinSlip = prm%h0_TwinSlip * stt%sumGamma(of)**prm%twinE + c_TwinTwin = prm%h0_TwinTwin * stt%sumF(of)**prm%twinD !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors and calculate dot gammas @@ -723,19 +723,13 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above - j = 0_pInt - slipFamilies2: do f = 1_pInt,size(prm%Nslip,1) - slipSystems2: do i = 1_pInt,prm%Nslip(f) - j = j+1_pInt - dotState(instance)%s_slip(j,of) = & ! evolution of slip resistance j - c_SlipSlip * left_SlipSlip(j) * & - dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor - dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + & - abs(gdot_slip(j)) - dotState(instance)%accshear_slip(j,of) = abs(gdot_slip(j)) - enddo slipSystems2 - enddo slipFamilies2 + do j = 1_pInt,prm%totalNslip + dotState(instance)%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j + dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor + enddo + dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + sum(abs(gdot_slip)) + dotState(instance)%accshear_slip(1:prm%totalNslip,of) = abs(gdot_slip) j = 0_pInt twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) @@ -801,8 +795,8 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt - outputsLoop: do o = 1_pInt,size(param(instance)%outputID) - select case(param(instance)%outputID(o)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) case (resistance_slip_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = state(instance)%s_slip(1:prm%totalNslip,of) c = c + prm%totalNslip @@ -813,22 +807,22 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (shearrate_slip_ID) j = 0_pInt - slipFamilies1: do f = 1_pInt,size(param(instance)%Nslip,1) + slipFamilies1: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,param(instance)%Nslip(f) + slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j + 1_pInt tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos +param(instance)%nonSchmidCoeff(k)* & + tau_slip_pos = tau_slip_pos +prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg +param(instance)%nonSchmidCoeff(k)* & + tau_slip_neg = tau_slip_neg +prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo - plastic_phenopowerlaw_postResults(c+j) = param(instance)%gdot0_slip*0.5_pReal* & - ((abs(tau_slip_pos)/state(instance)%s_slip(j,of))**param(instance)%n_slip & + plastic_phenopowerlaw_postResults(c+j) = prm%gdot0_slip*0.5_pReal* & + ((abs(tau_slip_pos)/state(instance)%s_slip(j,of))**prm%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & + +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**prm%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -836,9 +830,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (resolvedstress_slip_ID) j = 0_pInt - slipFamilies2: do f = 1_pInt,size(param(instance)%Nslip,1) + slipFamilies2: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) + slipSystems2: do i = 1_pInt,prm%Nslip(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) @@ -862,24 +856,24 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + prm%totalNtwin case (shearrate_twin_ID) j = 0_pInt - twinFamilies1: do f = 1_pInt,size(param(instance)%Ntwin,1) + twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,param(instance)%Ntwin(f) + twinSystems1: do i = 1_pInt,prm%Ntwin(f) j = j + 1_pInt tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F - param(instance)%gdot0_twin*& + prm%gdot0_twin*& (abs(tau)/state(instance)%s_twin(j,of))**& - param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) + prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) enddo twinSystems1 enddo twinFamilies1 c = c + prm%totalNtwin case (resolvedstress_twin_ID) j = 0_pInt - twinFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) + twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,param(instance)%Ntwin(f) + twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) From 94d4f271864f16f92017924e145502ddf6c2cfdd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 28 Jun 2018 15:15:48 +0200 Subject: [PATCH 032/208] incorporating changes from master branch of PRIVATE update of sns changed synta --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index d8ab8056d..43db3725c 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit d8ab8056d6245ce42bec8953de9af1d7754867cf +Subproject commit 43db3725cfe635806444a90f7f2c555537bbc801 From 613e976a86a02522d19de0e47fdc58d1f77cc8a5 Mon Sep 17 00:00:00 2001 From: Jaeyong Jung Date: Fri, 29 Jun 2018 15:36:12 +0200 Subject: [PATCH 033/208] the working directory and pathes of load and geometry files are now consistent. --- PRIVATE | 2 +- src/spectral_interface.f90 | 70 +++++++++++++------------------------- 2 files changed, 24 insertions(+), 48 deletions(-) diff --git a/PRIVATE b/PRIVATE index cd02f6c1a..798facf8e 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit cd02f6c1a481491eb4517651516b8311348b4777 +Subproject commit 798facf8e983c26dd635aca6a4b2c0b7ae3568fc diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index 41d62a3a9..88fbd2dae 100755 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -222,7 +222,6 @@ end subroutine DAMASK_interface_init !-------------------------------------------------------------------------------------------------- !> @brief extract working directory from given argument or from location of geometry file, !! possibly converting relative arguments to absolut path -!> @todo change working directory with call chdir(storeWorkingDirectory)? !-------------------------------------------------------------------------------------------------- character(len=1024) function storeWorkingDirectory(workingDirectoryArg) use system_routines, only: & @@ -231,7 +230,6 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg) implicit none character(len=*), intent(in) :: workingDirectoryArg !< working directory argument - character(len=1024) :: cwd logical :: error external :: quit @@ -239,16 +237,13 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg) absolutePath: if (workingDirectoryArg(1:1) == '/') then storeWorkingDirectory = workingDirectoryArg else absolutePath - error = getCWD(cwd) + error = getCWD(storeWorkingDirectory) if (error) call quit(1_pInt) - storeWorkingDirectory = trim(cwd)//'/'//workingDirectoryArg + storeWorkingDirectory = trim(storeWorkingDirectory)//'/'//workingDirectoryArg endif absolutePath - if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= '/') & - storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it else wdGiven - error = getCWD(cwd) ! relative path given as command line argument - if (error) call quit(1_pInt) - storeWorkingDirectory = trim(cwd)//'/' + error = getCWD(storeWorkingDirectory) ! relative path given as command line argument + if (error) call quit(1_pInt) endif wdGiven storeWorkingDirectory = trim(rectifyPath(storeWorkingDirectory)) @@ -257,6 +252,9 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg) call quit(1_pInt) endif + if (storeWorkingDirectory(len_trim(storeWorkingDirectory):len_trim(storeWorkingDirectory)) /= '/') & + storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it + end function storeWorkingDirectory @@ -301,35 +299,23 @@ end function getSolverJobName !> @brief basename of geometry file with extension from command line arguments !-------------------------------------------------------------------------------------------------- character(len=1024) function getGeometryFile(geometryParameter) - use system_routines, only: & - getCWD implicit none character(len=1024), intent(in) :: & geometryParameter - character(len=1024) :: & - cwd integer :: posExt, posSep - logical :: error external :: quit - getGeometryFile = geometryParameter + getGeometryFile = trim(geometryParameter) posExt = scan(getGeometryFile,'.',back=.true.) posSep = scan(getGeometryFile,'/',back=.true.) - if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present - if (scan(getGeometryFile,'/') /= 1) then ! relative path given as command line argument -! error = getcwd(cwd) -! if (error) call quit(1_pInt) -! getGeometryFile = rectifyPath(trim(workingDirectory)//'/'//getGeometryFile) - getGeometryFile = rectifyPath(trim(getSolverWorkingDirectoryName())//trim(getGeometryFile)) - else - getGeometryFile = rectifyPath(getGeometryFile) - endif - write(*,*) 'getsolv.. ', (getSolverWorkingDirectoryName()) - write(*,*) 'getGeometryFile.. ', (getGeometryFile) + if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') + if (scan(getGeometryFile,'/') /= 1) & + getGeometryFile = trim(getSolverWorkingDirectoryName())//trim(getGeometryFile) + + getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), rectifyPath(getGeometryFile)) - getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile) end function getGeometryFile @@ -338,39 +324,29 @@ end function getGeometryFile !> @brief relative path of loadcase from command line arguments !-------------------------------------------------------------------------------------------------- character(len=1024) function getLoadCaseFile(loadCaseParameter) - use system_routines, only: & - getCWD implicit none character(len=1024), intent(in) :: & loadCaseParameter - character(len=1024) :: & - cwd integer :: posExt, posSep - logical :: error external :: quit - getLoadCaseFile = loadcaseParameter + getLoadCaseFile = trim(loadCaseParameter) posExt = scan(getLoadCaseFile,'.',back=.true.) posSep = scan(getLoadCaseFile,'/',back=.true.) - if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present - if (scan(getLoadCaseFile,'/') /= 1) then ! relative path given as command line argument -! error = getcwd(cwd) -! if (error) call quit(1_pInt) -! getLoadCaseFile = rectifyPath(trim(workingDirectory)//'/'//getLoadCaseFile) - getLoadCaseFile = rectifyPath(trim(getSolverWorkingDirectoryName())//trim(getLoadCaseFile)) - else - getLoadCaseFile = rectifyPath(getLoadCaseFile) - endif + if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') + if (scan(getLoadCaseFile,'/') /= 1) & + getLoadCaseFile = trim(getSolverWorkingDirectoryName())//trim(getLoadCaseFile) - getLoadCaseFile = makeRelativePath(getSolverWorkingDirectoryName(), getLoadCaseFile) + getLoadCaseFile = makeRelativePath(getSolverWorkingDirectoryName(), rectifyPath(getLoadCaseFile)) end function getLoadCaseFile !-------------------------------------------------------------------------------------------------- -!> @brief remove ../ and /./ from path +!> @brief remove ../ and /./ from path. +!> @details works only if absolute path is given !-------------------------------------------------------------------------------------------------- function rectifyPath(path) @@ -384,14 +360,14 @@ function rectifyPath(path) l = len_trim(path) rectifyPath = path do i = l,3,-1 - if (rectifyPath(i-2:i) == '/'//'.'//'/') & + if (rectifyPath(i-2:i) == '/./') & rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' enddo !-------------------------------------------------------------------------------------------------- ! remove ../ and corresponding directory from rectifyPath l = len_trim(rectifyPath) - i = index(rectifyPath(i:l),'..'//'/') + i = index(rectifyPath(i:l),'../') j = 0 do while (i > j) j = scan(rectifyPath(1:i-2),'/',back=.true.) @@ -401,7 +377,7 @@ function rectifyPath(path) rectifyPath(j+1:k-1) = rectifyPath(j+2:k) rectifyPath(k:k) = ' ' endif - i = j+index(rectifyPath(j+1:l),'..'//'/') + i = j+index(rectifyPath(j+1:l),'../') enddo if(len_trim(rectifyPath) == 0) rectifyPath = '/' From 8c727eb4ff243ef56a25b8e699cbacc4a8802194 Mon Sep 17 00:00:00 2001 From: Yang Su Date: Fri, 29 Jun 2018 18:07:32 -0400 Subject: [PATCH 034/208] removed obsolete second assignment of slipRate and accSlip pointers --- src/plastic_phenopowerlaw.f90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index ee0702215..4f95bf292 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -455,11 +455,6 @@ subroutine plastic_phenopowerlaw_init dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - offset_slip = plasticState(p)%nSlip+plasticState(p)%nTwin+2_pInt - plasticState(p)%slipRate => & - plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) - plasticState(p)%accumulatedSlip => & - plasticState(p)%state(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) enddo From 980e34f7285ffa74d4b3ae5b6ecac03ff495f416 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 30 Jun 2018 13:37:13 +0200 Subject: [PATCH 035/208] state pointer as shortcut, variables not used --- src/plastic_phenopowerlaw.f90 | 45 ++++++++++++++++------------------- 1 file changed, 21 insertions(+), 24 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 4f95bf292..a387bad6d 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -1,3 +1,4 @@ +!-------------------------------------------------------------------------------------------------- !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH @@ -78,7 +79,8 @@ module plastic_phenopowerlaw s_slip, & s_twin, & accshear_slip, & - accshear_twin + accshear_twin, & + whole real(pReal), pointer, dimension(:) :: & sumGamma, & sumF @@ -142,7 +144,7 @@ subroutine plastic_phenopowerlaw_init maxNinstance, & instance,p,j,k, f,o, i,& NipcMyPhase, outputSize, & - offset_slip, index_myFamily, index_otherFamily, & + index_myFamily, index_otherFamily, & sizeState,sizeDotState, & startIndex, endIndex @@ -417,7 +419,6 @@ subroutine plastic_phenopowerlaw_init dotState(instance)%s_slip=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%state0(startIndex:endIndex,:) = & spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt @@ -454,11 +455,11 @@ subroutine plastic_phenopowerlaw_init state (instance)%accshear_twin=>plasticState(p)%state (startIndex:endIndex,:) dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - + + dotState(instance)%whole =>plasticState(p)%dotState enddo - end subroutine plastic_phenopowerlaw_init @@ -476,12 +477,11 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, lattice_Sslip_v, & lattice_Stwin, & lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & lattice_NslipSystem, & lattice_NtwinSystem use material, only: & - phaseAt, phasememberAt, & + phasememberAt, & + material_phase, & phase_plasticityInstance implicit none @@ -498,7 +498,6 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation integer(pInt) :: & - instance, & index_myFamily, & f,i,j,k,l,m,n, & of, & @@ -512,13 +511,14 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor real(pReal), dimension(3,3,2) :: & nonSchmid_tensor - type(tParameters), pointer :: prm + type(tParameters), pointer :: prm + type(tPhenopowerlawState), pointer :: stt of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) + ph = material_phase(ipc,ip,el) - prm => param(instance) + prm => param(phase_plasticityInstance(ph)) + stt => state(phase_plasticityInstance(ph)) Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal @@ -548,18 +548,16 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo gdot_slip_pos = 0.5_pReal*prm%gdot0_slip* & - ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of))) & - **prm%n_slip)*sign(1.0_pReal,tau_slip_pos) + ((abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_pos) gdot_slip_neg = 0.5_pReal*prm%gdot0_slip* & - ((abs(tau_slip_neg)/(state(instance)%s_slip(j,of))) & - **prm%n_slip)*sign(1.0_pReal,tau_slip_neg) + ((abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_neg) - Lp = Lp + (1.0_pReal-state(instance)%sumF(of))*& ! 1-F + Lp = Lp + (1.0_pReal-stt%sumF(of))*& (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! Calculation of the tangent of Lp - if (dNeq0(gdot_slip_pos)) then + if (dNeq0(gdot_slip_pos)) then !@ Philip: Needed? No division dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & @@ -567,7 +565,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, nonSchmid_tensor(m,n,1) endif - if (dNeq0(gdot_slip_neg)) then + if (dNeq0(gdot_slip_neg)) then !@ Philip: Needed? No division dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & @@ -587,14 +585,13 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, ! Calculation of Lp tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - gdot_twin = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F - prm%gdot0_twin*& - (abs(tau_twin)/state(instance)%s_twin(j,of))**& + gdot_twin = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin*& + (abs(tau_twin)/stt%s_twin(j,of))**& prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) ! Calculation of the tangent of Lp - if (dNeq0(gdot_twin)) then + if (dNeq0(gdot_twin)) then !@ Philip: Needed? No division dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & From c50f32b0d82f419a5de4200e5da26dd41b33278e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 30 Jun 2018 14:11:05 +0200 Subject: [PATCH 036/208] shorthand names improve readability for dotstate and LpAnd... --- src/plastic_phenopowerlaw.f90 | 52 +++++++++++++++-------------------- 1 file changed, 22 insertions(+), 30 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index a387bad6d..858e09564 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -613,15 +613,12 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) use lattice, only: & lattice_Sslip_v, & lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & lattice_NslipSystem, & lattice_NtwinSystem, & lattice_shearTwin use material, only: & material_phase, & - phaseAt, phasememberAt, & - plasticState, & + phasememberAt, & phase_plasticityInstance implicit none @@ -633,7 +630,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) el !< element !< microstructure state integer(pInt) :: & - instance,ph, & + ph, & f,i,j,k, & index_myFamily, & of @@ -642,21 +639,22 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ssat_offset, & tau_slip_pos,tau_slip_neg,tau_twin - real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Nslip) :: & + real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & gdot_slip,left_SlipSlip,right_SlipSlip - real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Ntwin) :: & + real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & gdot_twin - type(tParameters), pointer :: prm - type(tPhenopowerlawState), pointer :: stt + + type(tParameters), pointer :: prm + type(tPhenopowerlawState), pointer :: dst,stt of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - prm => param(instance) - stt => state(instance) + ph = material_phase(ipc,ip,el) + prm => param(phase_plasticityInstance(ph)) + stt => state(phase_plasticityInstance(ph)) + dst => dotState(phase_plasticityInstance(ph)) - plasticState(ph)%dotState(:,of) = 0.0_pReal + dst%whole(:,of) = 0.0_pReal !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices @@ -673,11 +671,8 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part - right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / & - (prm%tausat_slip(f)+ssat_offset)) & - **prm%a_slip& - *sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / & - (prm%tausat_slip(f)+ssat_offset)) + right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) **prm%a_slip & + * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) !-------------------------------------------------------------------------------------------------- ! Calculation of dot gamma @@ -695,8 +690,6 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) enddo slipSystems1 enddo slipFamilies1 - - j = 0_pInt twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family @@ -716,31 +709,30 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above do j = 1_pInt,prm%totalNslip - dotState(instance)%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j + dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor enddo - dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + sum(abs(gdot_slip)) - dotState(instance)%accshear_slip(1:prm%totalNslip,of) = abs(gdot_slip) + dst%sumGamma(of) = dst%sumGamma(of) + sum(abs(gdot_slip)) + dst%accshear_slip(1:prm%totalNslip,of) = abs(gdot_slip) j = 0_pInt twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt - dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j + dst%s_twin(j,of) = & ! evolution of twin resistance j c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor - if (state(instance)%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 - dotState(instance)%sumF(of) = dotState(instance)%sumF(of) + & - gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) - dotState(instance)%accshear_twin(j,of) = abs(gdot_twin(j)) + if (stt%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 + dst%sumF(of) = dst%sumF(of) + gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) + dst%accshear_twin(j,of) = abs(gdot_twin(j)) enddo twinSystems2 enddo twinFamilies2 - end subroutine plastic_phenopowerlaw_dotState + !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- From b1c37996d349a11b6f7cf32cc6515b36771f0cf0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 30 Jun 2018 14:35:58 +0200 Subject: [PATCH 037/208] also using short names for state and dotstate in postResults --- src/plastic_phenopowerlaw.f90 | 39 ++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 858e09564..e7981c6d1 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -740,13 +740,11 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) use material, only: & material_phase, & plasticState, & - phaseAt, phasememberAt, & + phasememberAt, & phase_plasticityInstance use lattice, only: & lattice_Sslip_v, & lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & lattice_NslipSystem, & lattice_NtwinSystem, & lattice_NnonSchmid @@ -763,17 +761,21 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) plastic_phenopowerlaw_postResults integer(pInt) :: & - instance,ph, of, & + ph, of, & o,f,i,c,j,k, & index_myFamily real(pReal) :: & tau_slip_pos,tau_slip_neg,tau - type(tParameters), pointer :: prm + + type(tParameters), pointer :: prm + type(tPhenopowerlawState), pointer :: stt, dst of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - prm => param(instance) + ph = material_phase(ipc,ip,el) + + stt => state(phase_plasticityInstance(ph)) + dst => dotstate(phase_plasticityInstance(ph)) + prm => param(phase_plasticityInstance(ph)) plastic_phenopowerlaw_postResults = 0.0_pReal @@ -782,11 +784,11 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) case (resistance_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = state(instance)%s_slip(1:prm%totalNslip,of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = stt%s_slip(1:prm%totalNslip,of) c = c + prm%totalNslip case (accumulatedshear_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = state(instance)%accshear_slip(1:prm%totalNslip,of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1:prm%totalNslip,of) c = c + prm%totalNslip case (shearrate_slip_ID) @@ -804,9 +806,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo plastic_phenopowerlaw_postResults(c+j) = prm%gdot0_slip*0.5_pReal* & - ((abs(tau_slip_pos)/state(instance)%s_slip(j,of))**prm%n_slip & + ((abs(tau_slip_pos)/stt%s_slip(j,of))**prm%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**prm%n_slip & + +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -825,18 +827,17 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + prm%totalNslip case (totalshear_ID) - plastic_phenopowerlaw_postResults(c+1_pInt) = & - state(instance)%sumGamma(of) + plastic_phenopowerlaw_postResults(c+1_pInt) = stt%sumGamma(of) c = c + 1_pInt case (resistance_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & - state(instance)%s_twin(1:prm%totalNtwin,of) + stt%s_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (accumulatedshear_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & - state(instance)%accshear_twin(1:prm%totalNtwin,of) + stt%accshear_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (shearrate_twin_ID) j = 0_pInt @@ -845,9 +846,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) twinSystems1: do i = 1_pInt,prm%Ntwin(f) j = j + 1_pInt tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F + plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-stt%sumF(of))*& ! 1-F prm%gdot0_twin*& - (abs(tau)/state(instance)%s_twin(j,of))**& + (abs(tau)/stt%s_twin(j,of))**& prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) enddo twinSystems1 enddo twinFamilies1 @@ -866,7 +867,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + prm%totalNtwin case (totalvolfrac_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt) = state(instance)%sumF(of) + plastic_phenopowerlaw_postResults(c+1_pInt) = stt%sumF(of) c = c + 1_pInt end select From 7ca005d237684a378a5973a68353ad5d9df7fe98 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 5 Jul 2018 15:44:25 +0200 Subject: [PATCH 038/208] avoiding division by zero --- src/plastic_phenopowerlaw.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index e7981c6d1..d7be6a44b 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -557,7 +557,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! Calculation of the tangent of Lp - if (dNeq0(gdot_slip_pos)) then !@ Philip: Needed? No division + if (dNeq0(tau_slip_pos)) then dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & @@ -565,7 +565,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, nonSchmid_tensor(m,n,1) endif - if (dNeq0(gdot_slip_neg)) then !@ Philip: Needed? No division + if (dNeq0(tau_slip_neg)) then dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & From ac7bc4b9ed1a74cb1c4c145b3e4ea22f8bb25f72 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 08:24:45 +0200 Subject: [PATCH 039/208] dont' store the working directory but set it centrally makes life easier, writing and reading always to CWD unless absolute path is given Spectral: using --wd argrument and C code MSC.Marc: using directory of input deck and Intel extension Abaqus: using function and Intel extension --- src/DAMASK_abaqus.f | 59 +++++++++++++++--------------- src/DAMASK_marc.f90 | 73 ++++++++++++++------------------------ src/DAMASK_spectral.f90 | 19 +++++----- src/IO.f90 | 57 ++++++++++------------------- src/debug.f90 | 2 -- src/spectral_interface.f90 | 57 +++++++++++++---------------- 6 files changed, 110 insertions(+), 157 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index e91cbb0bb..e0045a2eb 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -3,38 +3,42 @@ !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Koen Janssens, Paul Scherrer Institut !> @author Arun Prakash, Fraunhofer IWM +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief interfaces DAMASK with Abaqus/Standard !> @details put the included file abaqus_v6.env in either your home or model directory, !> it is a minimum Abaqus environment file containing all changes necessary to use the !> DAMASK subroutine (see Abaqus documentation for more information on the use of abaqus_v6.env) !-------------------------------------------------------------------------------------------------- - -#ifndef INT -#define INT 4 -#endif - -#ifndef FLOAT -#define FLOAT 8 -#endif - #define Abaqus #include "prec.f90" module DAMASK_interface -implicit none -character(len=4), dimension(2), parameter :: INPUTFILEEXTENSION = ['.pes','.inp'] -character(len=4), parameter :: LOGFILEEXTENSION = '.log' + implicit none + private + character(len=4), dimension(2), parameter, public :: INPUTFILEEXTENSION = ['.pes','.inp'] + character(len=4), parameter, public :: LOGFILEEXTENSION = '.log' + + public :: & + DAMASK_interface_init, & + getSolverJobName contains !-------------------------------------------------------------------------------------------------- -!> @brief just reporting +!> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init + use ifport, only: & + CHDIR + + implicit none integer, dimension(8) :: & dateAndTime ! type default integer + integer :: lenOutDir,ierr + character(len=256) :: wd + call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>' write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' @@ -46,26 +50,16 @@ subroutine DAMASK_interface_init dateAndTime(6),':',& dateAndTime(7) write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' + + call getoutdir(wd, lenOutDir) + ierr = CHDIR(wd) + if (ierr /= 0) call quit(0) + #include "compilation_info.f90" end subroutine DAMASK_interface_init -!-------------------------------------------------------------------------------------------------- -!> @brief using Abaqus/Standard function to get working directory name -!-------------------------------------------------------------------------------------------------- -character(1024) function getSolverWorkingDirectoryName() - - implicit none - integer :: lenOutDir - - getSolverWorkingDirectoryName='' - call getoutdir(getSolverWorkingDirectoryName, lenOutDir) - getSolverWorkingDirectoryName=trim(getSolverWorkingDirectoryName)//'/' - -end function getSolverWorkingDirectoryName - - !-------------------------------------------------------------------------------------------------- !> @brief using Abaqus/Standard function to get solver job name !-------------------------------------------------------------------------------------------------- @@ -79,10 +73,17 @@ character(1024) function getSolverJobName() end function getSolverJobName + end module DAMASK_interface -#include "commercialFEM_fileList.f90" + + +#include "commercialFEM_fileList.f90" + +!-------------------------------------------------------------------------------------------------- +!> @brief This is the Abaqus std user subroutine for defining material behavior +!-------------------------------------------------------------------------------------------------- subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,& RPL,DDSDDT,DRPLDE,DRPLDT,STRAN,DSTRAN,& TIME,DTIME,TEMP,DTEMP,PREDEF,DPRED,CMNAME,NDI,NSHR,NTENS,& diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 81465350c..51006de72 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -1,15 +1,3 @@ -#define QUOTE(x) #x -#define PASTE(x,y) x ## y - -#ifndef INT -#define INT 4 -#endif - -#ifndef FLOAT -#define FLOAT 8 -#endif - -#include "prec.f90" !-------------------------------------------------------------------------------------------------- !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH @@ -17,13 +5,12 @@ !> @author W.A. Counts !> @author Denny Tjahjanto, Max-Planck-Institut für Eisenforschung GmbH !> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Material subroutine for MSC.Marc +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Interfaces DAMASK with MSC.Marc !> @details Usage: !> @details - choose material as hypela2 !> @details - set statevariable 2 to index of homogenization !> @details - set statevariable 3 to index of microstructure -!> @details - make sure the file "material.config" exists in the working directory -!> @details - make sure the file "numerics.config" exists in the working directory !> @details - use nonsymmetric option for solver (e.g. direct profile or multifrontal sparse, the latter seems to be faster!) !> @details - in case of ddm (domain decomposition) a SYMMETRIC solver has to be used, i.e uncheck "non-symmetric" !> @details Marc subroutines used: @@ -34,23 +21,36 @@ !> @details - concom: lovl, inc !> @details - creeps: timinc !-------------------------------------------------------------------------------------------------- +#define QUOTE(x) #x +#define PASTE(x,y) x ## y + +#include "prec.f90" + module DAMASK_interface implicit none - character(len=4), parameter :: InputFileExtension = '.dat' - character(len=4), parameter :: LogFileExtension = '.log' + private + character(len=4), parameter, public :: InputFileExtension = '.dat' + character(len=4), parameter, public :: LogFileExtension = '.log' + + public :: & + DAMASK_interface_init, & + getSolverJobName contains - !-------------------------------------------------------------------------------------------------- -!> @brief only output of current version +!> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init + use ifport, only: & + CHDIR implicit none integer, dimension(8) :: & dateAndTime ! type default integer + integer :: ierr + character(len=1024) :: wd call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>' @@ -64,27 +64,14 @@ subroutine DAMASK_interface_init dateAndTime(7) write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' #include "compilation_info.f90" + inquire(5, name=wd) ! determine inputputfile + wd = wd(1:scan(wd,'/',back=.true.)) + ierr = CHDIR(wd) + if (ierr /= 0) call quit(0) end subroutine DAMASK_interface_init -!-------------------------------------------------------------------------------------------------- -!> @brief returns the current workingDir -!-------------------------------------------------------------------------------------------------- -function getSolverWorkingDirectoryName() - - implicit none - character(1024) getSolverWorkingDirectoryName, inputName - character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash - - getSolverWorkingDirectoryName='' - inputName='' - inquire(5, name=inputName) ! determine inputputfile - getSolverWorkingDirectoryName=inputName(1:scan(inputName,pathSep,back=.true.)) - -end function getSolverWorkingDirectoryName - - !-------------------------------------------------------------------------------------------------- !> @brief solver job name (no extension) as combination of geometry and load case name !-------------------------------------------------------------------------------------------------- @@ -109,6 +96,9 @@ end function getSolverJobName end module DAMASK_interface + + + #include "commercialFEM_fileList.f90" !-------------------------------------------------------------------------------------------------- @@ -118,17 +108,6 @@ end module DAMASK_interface !> @details !> @details (2) Use the -> 'Plasticity,3' card(=update+finite+large disp+constant d) !> @details in the parameter section of input deck (updated Lagrangian formulation). -!> @details -!> @details The following operation obtains U (stretch tensor) at t=n+1 : -!> @details -!> @details call scla(un1,0.d0,itel,itel,1) -!> @details do k=1,3 -!> @details do i=1,3 -!> @details do j=1,3 -!> @details un1(i,j)=un1(i,j)+dsqrt(strechn1(k))*eigvn1(i,k)*eigvn1(j,k) -!> @details enddo -!> @details enddo -!> @details enddo !-------------------------------------------------------------------------------------------------- subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, & diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 0d77c57f5..2ed94d06a 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -20,11 +20,12 @@ program DAMASK_spectral pReal, & tol_math_check, & dNeq + use system_routines, only: & + getCWD use DAMASK_interface, only: & DAMASK_interface_init, & loadCaseFile, & geometryFile, & - getSolverWorkingDirectoryName, & getSolverJobName, & appendToOutFile use IO, only: & @@ -133,7 +134,9 @@ program DAMASK_spectral lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written stagIter character(len=6) :: loadcase_string - character(len=1024) :: incInfo !< string parsed to solution with information about current load case + character(len=1024) :: & + incInfo, & !< string parsed to solution with information about current load case + workingDir type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases type(tSolutionState), allocatable, dimension(:) :: solres integer(MPI_OFFSET_KIND) :: fileOffset @@ -381,10 +384,11 @@ program DAMASK_spectral ! write header of output file if (worldrank == 0) then if (.not. appendToOutFile) then ! after restart, append to existing results file - open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& + if (getCWD(workingDir)) call IO_error(106_pInt,ext_msg=trim(workingDir)) + open(newunit=resUnit,file=trim(getSolverJobName())//& '.spectralOut',form='UNFORMATTED',status='REPLACE') write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header - write(resUnit) 'workingdir:', trim(getSolverWorkingDirectoryName()) + write(resUnit) 'workingdir:', trim(workingDir) write(resUnit) 'geometry:', trim(geometryFile) write(resUnit) 'grid:', grid write(resUnit) 'size:', geomSize @@ -397,14 +401,14 @@ program DAMASK_spectral write(resUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc write(resUnit) 'eoh' close(resUnit) ! end of header - open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& + open(newunit=statUnit,file=trim(getSolverJobName())//& '.sta',form='FORMATTED',status='REPLACE') write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) & write(6,'(/,a)') ' header of result and statistics file written out' flush(6) else ! open new files ... - open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& + open(newunit=statUnit,file=trim(getSolverJobName())//& '.sta',form='FORMATTED', position='APPEND', status='OLD') endif endif @@ -415,8 +419,7 @@ program DAMASK_spectral outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND) call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce') - call MPI_file_open(PETSC_COMM_WORLD, & - trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.spectralOut', & + call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', & MPI_MODE_WRONLY + MPI_MODE_APPEND, & MPI_INFO_NULL, & resUnit, & diff --git a/src/IO.f90 b/src/IO.f90 index a7e77f0f4..fd1a36339 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -195,18 +195,14 @@ end subroutine IO_checkAndRewind !> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return !! value !-------------------------------------------------------------------------------------------------- -subroutine IO_open_file(fileUnit,relPath) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName +subroutine IO_open_file(fileUnit,path) implicit none integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: relPath !< relative path from working directory + character(len=*), intent(in) :: path !< relative path from working directory integer(pInt) :: myStat - character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//relPath open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -218,18 +214,14 @@ end subroutine IO_open_file !! directory !> @details Like IO_open_file, but error is handled via return value and not via call to IO_error !-------------------------------------------------------------------------------------------------- -logical function IO_open_file_stat(fileUnit,relPath) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName +logical function IO_open_file_stat(fileUnit,path) implicit none integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: relPath !< relative path from working directory + character(len=*), intent(in) :: path !< relative path from working directory integer(pInt) :: myStat - character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//relPath open(fileUnit,status='old',iostat=myStat,file=path) IO_open_file_stat = (myStat == 0_pInt) @@ -244,7 +236,6 @@ end function IO_open_file_stat !-------------------------------------------------------------------------------------------------- subroutine IO_open_jobFile(fileUnit,ext) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -254,7 +245,7 @@ subroutine IO_open_jobFile(fileUnit,ext) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -269,7 +260,6 @@ end subroutine IO_open_jobFile !-------------------------------------------------------------------------------------------------- logical function IO_open_jobFile_stat(fileUnit,ext) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -279,7 +269,7 @@ logical function IO_open_jobFile_stat(fileUnit,ext) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext open(fileUnit,status='old',iostat=myStat,file=path) IO_open_jobFile_stat = (myStat == 0_pInt) @@ -292,7 +282,6 @@ end function IO_open_JobFile_stat !-------------------------------------------------------------------------------------------------- subroutine IO_open_inputFile(fileUnit,modelName) use DAMASK_interface, only: & - getSolverWorkingDirectoryName,& getSolverJobName, & inputFileExtension @@ -306,23 +295,23 @@ subroutine IO_open_inputFile(fileUnit,modelName) integer(pInt) :: fileType fileType = 1_pInt ! assume .pes - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used + path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used open(fileUnit+1,status='old',iostat=myStat,file=path) if(myStat /= 0_pInt) then ! if .pes does not work / exist; use conventional extension, i.e.".inp" fileType = 2_pInt - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) + path = trim(modelName)//inputFileExtension(fileType) open(fileUnit+1,status='old',iostat=myStat,file=path) endif if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)//'_assembly' + path = trim(modelName)//inputFileExtension(fileType)//'_assembly' open(fileUnit,iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s close(fileUnit+1_pInt) #endif #ifdef Marc4DAMASK - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension + path = trim(modelName)//inputFileExtension open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) #endif @@ -336,7 +325,6 @@ end subroutine IO_open_inputFile !-------------------------------------------------------------------------------------------------- subroutine IO_open_logFile(fileUnit) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName, & LogFileExtension @@ -346,7 +334,7 @@ subroutine IO_open_logFile(fileUnit) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//LogFileExtension + path = trim(getSolverJobName())//LogFileExtension open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -360,7 +348,6 @@ end subroutine IO_open_logFile !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobFile(fileUnit,ext) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -370,7 +357,7 @@ subroutine IO_write_jobFile(fileUnit,ext) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext open(fileUnit,status='replace',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -383,7 +370,6 @@ end subroutine IO_write_jobFile !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -394,7 +380,7 @@ subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='replace',form='unformatted',access='direct', & recl=pReal*recMultiplier,iostat=myStat,file=path) @@ -414,7 +400,6 @@ end subroutine IO_write_jobRealFile !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -425,7 +410,7 @@ subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='replace',form='unformatted',access='direct', & recl=pInt*recMultiplier,iostat=myStat,file=path) @@ -444,8 +429,6 @@ end subroutine IO_write_jobIntFile !! located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: fileUnit !< file unit @@ -456,7 +439,7 @@ subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext + path = trim(modelName)//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='old',form='unformatted',access='direct', & recl=pReal*recMultiplier,iostat=myStat,file=path) @@ -474,8 +457,6 @@ end subroutine IO_read_realFile !! located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: fileUnit !< file unit @@ -486,7 +467,7 @@ subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext + path = trim(modelName)//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='old',form='unformatted',access='direct', & recl=pInt*recMultiplier,iostat=myStat,file=path) @@ -1534,6 +1515,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = '{input} recursion limit reached' case (105_pInt) msg = 'unknown output:' + case (106_pInt) + msg = 'working directory does not exist:' !-------------------------------------------------------------------------------------------------- ! lattice error messages @@ -1905,8 +1888,6 @@ end function IO_verifyFloatValue !> including "include"s !-------------------------------------------------------------------------------------------------- recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: unit1, & @@ -1923,7 +1904,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) chunkPos = IO_stringPos(line) if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then - fname = trim(getSolverWorkingDirectoryName())//trim(line(9+scan(line(9:),'='):)) + fname = trim(line(9+scan(line(9:),'='):)) inquire(file=fname, exist=fexist) if (.not.(fexist)) then !$OMP CRITICAL (write2out) diff --git a/src/debug.f90 b/src/debug.f90 index ea2b659a1..e5079bff2 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -283,8 +283,6 @@ end subroutine debug_reset subroutine debug_info implicit none - character(len=1) :: exceed - !$OMP CRITICAL (write2out) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index 88fbd2dae..b1b536a7c 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -19,14 +19,13 @@ module DAMASK_interface character(len=1024), public, protected :: & geometryFile = '', & !< parameter given for geometry file loadCaseFile = '' !< parameter given for load case file - character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons + character(len=1024), private :: workingDirectory public :: & - getSolverWorkingDirectoryName, & getSolverJobName, & DAMASK_interface_init private :: & - storeWorkingDirectory, & + setWorkingDirectory, & getGeometryFile, & getLoadCaseFile, & rectifyPath, & @@ -195,7 +194,7 @@ subroutine DAMASK_interface_init() call quit(1_pInt) endif - workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg))) + workingDirectory = trim(setWorkingDirectory(trim(workingDirArg))) geometryFile = getGeometryFile(geometryArg) loadCaseFile = getLoadCaseFile(loadCaseArg) @@ -208,7 +207,7 @@ subroutine DAMASK_interface_init() write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg) - write(6,'(a,a)') ' Working directory: ', trim(getSolverWorkingDirectoryName()) + write(6,'(a,a)') ' Working directory: ', trim(workingDirectory) write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) @@ -223,10 +222,11 @@ end subroutine DAMASK_interface_init !> @brief extract working directory from given argument or from location of geometry file, !! possibly converting relative arguments to absolut path !-------------------------------------------------------------------------------------------------- -character(len=1024) function storeWorkingDirectory(workingDirectoryArg) +character(len=1024) function setWorkingDirectory(workingDirectoryArg) use system_routines, only: & isDirectory, & - getCWD + getCWD, & + setCWD implicit none character(len=*), intent(in) :: workingDirectoryArg !< working directory argument @@ -235,39 +235,30 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg) wdGiven: if (len(workingDirectoryArg)>0) then absolutePath: if (workingDirectoryArg(1:1) == '/') then - storeWorkingDirectory = workingDirectoryArg + setWorkingDirectory = workingDirectoryArg else absolutePath - error = getCWD(storeWorkingDirectory) + error = getCWD(setWorkingDirectory) if (error) call quit(1_pInt) - storeWorkingDirectory = trim(storeWorkingDirectory)//'/'//workingDirectoryArg + setWorkingDirectory = trim(setWorkingDirectory)//'/'//workingDirectoryArg endif absolutePath else wdGiven - error = getCWD(storeWorkingDirectory) ! relative path given as command line argument + error = getCWD(setWorkingDirectory) ! relative path given as command line argument if (error) call quit(1_pInt) endif wdGiven - storeWorkingDirectory = trim(rectifyPath(storeWorkingDirectory)) - if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists - write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist' + setWorkingDirectory = trim(rectifyPath(setWorkingDirectory)) + if(.not. isDirectory(trim(setWorkingDirectory))) then ! check if the directory exists + write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist' call quit(1_pInt) endif - if (storeWorkingDirectory(len_trim(storeWorkingDirectory):len_trim(storeWorkingDirectory)) /= '/') & - storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it + if (setWorkingDirectory(len_trim(setWorkingDirectory):len_trim(setWorkingDirectory)) /= '/') & + setWorkingDirectory = trim(setWorkingDirectory)//'/' ! if path seperator is not given, append it + + error = setCWD(setWorkingDirectory(1:len_trim(setWorkingDirectory)-1)) ! path seperator at end causes problems + if (error) call quit(1_pInt) -end function storeWorkingDirectory - - -!-------------------------------------------------------------------------------------------------- -!> @brief simply returns the private string workingDir -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getSolverWorkingDirectoryName() - - implicit none - - getSolverWorkingDirectoryName = workingDirectory - -end function getSolverWorkingDirectoryName +end function setWorkingDirectory !-------------------------------------------------------------------------------------------------- @@ -312,9 +303,9 @@ character(len=1024) function getGeometryFile(geometryParameter) if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') if (scan(getGeometryFile,'/') /= 1) & - getGeometryFile = trim(getSolverWorkingDirectoryName())//trim(getGeometryFile) + getGeometryFile = trim(workingDirectory)//trim(getGeometryFile) - getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), rectifyPath(getGeometryFile)) + getGeometryFile = makeRelativePath(workingDirectory, rectifyPath(getGeometryFile)) end function getGeometryFile @@ -337,9 +328,9 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') if (scan(getLoadCaseFile,'/') /= 1) & - getLoadCaseFile = trim(getSolverWorkingDirectoryName())//trim(getLoadCaseFile) + getLoadCaseFile = trim(workingDirectory)//trim(getLoadCaseFile) - getLoadCaseFile = makeRelativePath(getSolverWorkingDirectoryName(), rectifyPath(getLoadCaseFile)) + getLoadCaseFile = makeRelativePath(workingDirectory, rectifyPath(getLoadCaseFile)) end function getLoadCaseFile From 70a3db275a8bb3b896ab5967b8bfdda71bad4ccf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 09:53:20 +0200 Subject: [PATCH 040/208] verbose error message --- src/DAMASK_abaqus.f | 5 ++++- src/DAMASK_marc.f90 | 5 ++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index e0045a2eb..69f6fba4b 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -53,7 +53,10 @@ subroutine DAMASK_interface_init call getoutdir(wd, lenOutDir) ierr = CHDIR(wd) - if (ierr /= 0) call quit(0) + if (ierr /= 0) then + write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist' + call quit(1) + endif #include "compilation_info.f90" diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 51006de72..0f3be66d0 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -67,7 +67,10 @@ subroutine DAMASK_interface_init inquire(5, name=wd) ! determine inputputfile wd = wd(1:scan(wd,'/',back=.true.)) ierr = CHDIR(wd) - if (ierr /= 0) call quit(0) + if (ierr /= 0) then + write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist' + call quit(1) + endif end subroutine DAMASK_interface_init From 1336f8f129155e6dbd3279c26790837e7d10634b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 10:23:21 +0200 Subject: [PATCH 041/208] cleanding and simplifying 1) arguments are case sensitive, i.e. -H is NOT -h 2) don't rely on trailing '/' for working dir 3) when adding '/' to working dir, rectify path should take care of '//' --- src/spectral_interface.f90 | 87 +++++++++++++++----------------------- 1 file changed, 33 insertions(+), 54 deletions(-) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index b1b536a7c..c38f32723 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -32,7 +32,6 @@ module DAMASK_interface makeRelativePath, & IIO_stringValue, & IIO_intValue, & - IIO_lc, & IIO_stringPos contains @@ -128,7 +127,7 @@ subroutine DAMASK_interface_init() call get_command(commandLine) chunkPos = IIO_stringPos(commandLine) do i = 1, chunkPos(1) - tag = IIO_lc(IIO_stringValue(commandLine,chunkPos,i)) ! extract key + tag = IIO_stringValue(commandLine,chunkPos,i) ! extract key select case(tag) case ('-h','--help') write(6,'(a)') ' #######################################################################' @@ -224,7 +223,6 @@ end subroutine DAMASK_interface_init !-------------------------------------------------------------------------------------------------- character(len=1024) function setWorkingDirectory(workingDirectoryArg) use system_routines, only: & - isDirectory, & getCWD, & setCWD @@ -247,16 +245,12 @@ character(len=1024) function setWorkingDirectory(workingDirectoryArg) endif wdGiven setWorkingDirectory = trim(rectifyPath(setWorkingDirectory)) - if(.not. isDirectory(trim(setWorkingDirectory))) then ! check if the directory exists - write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist' - call quit(1_pInt) - endif - if (setWorkingDirectory(len_trim(setWorkingDirectory):len_trim(setWorkingDirectory)) /= '/') & - setWorkingDirectory = trim(setWorkingDirectory)//'/' ! if path seperator is not given, append it - - error = setCWD(setWorkingDirectory(1:len_trim(setWorkingDirectory)-1)) ! path seperator at end causes problems - if (error) call quit(1_pInt) + error = setCWD(trim(setWorkingDirectory)) + if(error) then + write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist' + call quit(1_pInt) + endif end function setWorkingDirectory @@ -303,9 +297,9 @@ character(len=1024) function getGeometryFile(geometryParameter) if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') if (scan(getGeometryFile,'/') /= 1) & - getGeometryFile = trim(workingDirectory)//trim(getGeometryFile) + getGeometryFile = trim(workingDirectory)//'/'//trim(getGeometryFile) - getGeometryFile = makeRelativePath(workingDirectory, rectifyPath(getGeometryFile)) + getGeometryFile = makeRelativePath(workingDirectory, getGeometryFile) end function getGeometryFile @@ -328,15 +322,15 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') if (scan(getLoadCaseFile,'/') /= 1) & - getLoadCaseFile = trim(workingDirectory)//trim(getLoadCaseFile) + getLoadCaseFile = trim(workingDirectory)//'/'//trim(getLoadCaseFile) - getLoadCaseFile = makeRelativePath(workingDirectory, rectifyPath(getLoadCaseFile)) + getLoadCaseFile = makeRelativePath(workingDirectory, getLoadCaseFile) end function getLoadCaseFile !-------------------------------------------------------------------------------------------------- -!> @brief remove ../ and /./ from path. +!> @brief remove ../, /./, and // from path. !> @details works only if absolute path is given !-------------------------------------------------------------------------------------------------- function rectifyPath(path) @@ -351,8 +345,15 @@ function rectifyPath(path) l = len_trim(path) rectifyPath = path do i = l,3,-1 - if (rectifyPath(i-2:i) == '/./') & - rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' + if (rectifyPath(i-2:i) == '/./') rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' + enddo + +!-------------------------------------------------------------------------------------------------- +! remove // from path + l = len_trim(path) + rectifyPath = path + do i = l,2,-1 + if (rectifyPath(i-1:i) == '//') rectifyPath(i-1:l) = rectifyPath(i:l)//' ' enddo !-------------------------------------------------------------------------------------------------- @@ -381,20 +382,24 @@ end function rectifyPath character(len=1024) function makeRelativePath(a,b) implicit none - character (len=*) :: a,b + character (len=*), intent(in) :: a,b + character (len=1024) :: a_cleaned,b_cleaned integer :: i,posLastCommonSlash,remainingSlashes !no pInt posLastCommonSlash = 0 remainingSlashes = 0 + a_cleaned = rectifyPath(trim(a)//'/') + b_cleaned = rectifyPath(b) - do i = 1, min(1024,len_trim(a),len_trim(b)) - if (a(i:i) /= b(i:i)) exit - if (a(i:i) == '/') posLastCommonSlash = i + do i = 1, min(1024,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 - do i = posLastCommonSlash+1,len_trim(a) - if (a(i:i) == '/') remainingSlashes = remainingSlashes + 1 + do i = posLastCommonSlash+1,len_trim(a_cleaned) + if (a_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1 enddo - makeRelativePath = repeat('..'//'/',remainingSlashes)//b(posLastCommonSlash+1:len_trim(b)) + + makeRelativePath = repeat('..'//'/',remainingSlashes)//b_cleaned(posLastCommonSlash+1:len_trim(b_cleaned)) end function makeRelativePath @@ -411,11 +416,8 @@ pure function IIO_stringValue(string,chunkPos,myChunk) character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then - IIO_stringValue = '' - else valuePresent - IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) - endif valuePresent + IIO_stringValue = merge('',string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) + (myChunk > chunkPos(1) .or. myChunk < 1_pInt)) end function IIO_stringValue @@ -442,29 +444,6 @@ integer(pInt) pure function IIO_intValue(string,chunkPos,myChunk) end function IIO_intValue -!-------------------------------------------------------------------------------------------------- -!> @brief taken from IO, check IO_lc for documentation -!-------------------------------------------------------------------------------------------------- -pure function IIO_lc(string) - - implicit none - character(len=*), intent(in) :: string !< string to convert - character(len=len(string)) :: IIO_lc - - character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' - character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - - integer :: i,n ! no pInt (len returns default integer) - - IIO_lc = string - do i=1,len(string) - n = index(UPPER,IIO_lc(i:i)) - if (n/=0) IIO_lc(i:i) = LOWER(n:n) - enddo - -end function IIO_lc - - !-------------------------------------------------------------------------------------------------- !> @brief taken from IO, check IO_stringPos for documentation !-------------------------------------------------------------------------------------------------- From 5fbe43053f23acf2b7bfce32b8970f8311a2aafa Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 10:26:07 +0200 Subject: [PATCH 042/208] more logical names in test --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 114f2bd9c..14b60c558 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 114f2bd9c2025b30c0c6200709bd4b3b0cc1963a +Subproject commit 14b60c558375731e80db8e5fa49cba753f0d0939 From f493a5419be0a2bf64afdfe7216399d18ad7211d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 10:39:24 +0200 Subject: [PATCH 043/208] forgot line continuation --- src/spectral_interface.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index c38f32723..02d4dc0d8 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -416,7 +416,7 @@ pure function IIO_stringValue(string,chunkPos,myChunk) character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - IIO_stringValue = merge('',string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) + IIO_stringValue = merge('',string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)),& (myChunk > chunkPos(1) .or. myChunk < 1_pInt)) end function IIO_stringValue From a4e4a9c4ab25da60011c7db76b7fbac29ac6ed87 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 21:40:01 +0200 Subject: [PATCH 044/208] merge does not work for strings of different length fixed possible out of bounds access --- src/IO.f90 | 6 +----- src/spectral_interface.f90 | 41 +++++++++++++++++++------------------- 2 files changed, 21 insertions(+), 26 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index fd1a36339..807686e86 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -988,11 +988,7 @@ function IO_stringValue(string,chunkPos,myChunk,silent) logical :: warn - if (.not. present(silent)) then - warn = .false. - else - warn = silent - endif + warn = merge(silent,.false.,present(silent)) IO_stringValue = '' valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index 02d4dc0d8..1ab92a178 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -55,9 +55,9 @@ subroutine DAMASK_interface_init() implicit none character(len=1024) :: & commandLine, & !< command line call as string - loadCaseArg ='', & !< -l argument given to DAMASK_spectral.exe - geometryArg ='', & !< -g argument given to DAMASK_spectral.exe - workingDirArg ='', & !< -w argument given to DAMASK_spectral.exe + loadcaseArg = '', & !< -l argument given to DAMASK_spectral.exe + geometryArg = '', & !< -g argument given to DAMASK_spectral.exe + workingDirArg = '', & !< -w argument given to DAMASK_spectral.exe hostName, & !< name of machine on which DAMASK_spectral.exe is execute (might require export HOSTNAME) userName, & !< name of user calling DAMASK_spectral.exe tag @@ -112,7 +112,7 @@ subroutine DAMASK_interface_init() call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' + write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& @@ -126,9 +126,8 @@ subroutine DAMASK_interface_init() call get_command(commandLine) chunkPos = IIO_stringPos(commandLine) - do i = 1, chunkPos(1) - tag = IIO_stringValue(commandLine,chunkPos,i) ! extract key - select case(tag) + do i = 2_pInt, chunkPos(1) + select case(IIO_stringValue(commandLine,chunkPos,i)) ! extract key case ('-h','--help') write(6,'(a)') ' #######################################################################' write(6,'(a)') ' DAMASK_spectral:' @@ -177,18 +176,20 @@ subroutine DAMASK_interface_init() write(6,'(a,/)')' Prints this message and exits' call quit(0_pInt) ! normal Termination case ('-l', '--load', '--loadcase') - loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) + if ( i < chunkPos(1)) loadcaseArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) case ('-g', '--geom', '--geometry') - geometryArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) + if (i < chunkPos(1)) geometryArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory') - workingDirArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) + if (i < chunkPos(1)) workingDirArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) case ('-r', '--rs', '--restart') - spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) - appendToOutFile = .true. + if (i < chunkPos(1)) then + spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) + appendToOutFile = .true. + endif end select enddo - - if (len(trim(loadcaseArg)) == 0 .or. len(trim(geometryArg)) == 0) then + + if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0) then write(6,'(a)') ' Please specify geometry AND load case (-h for help)' call quit(1_pInt) endif @@ -410,14 +411,12 @@ end function makeRelativePath pure function IIO_stringValue(string,chunkPos,myChunk) implicit none - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - character(len=1+chunkPos(myChunk*2+1)-chunkPos(myChunk*2)) :: IIO_stringValue - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + integer(pInt), intent(in) :: myChunk !< position number of desired chunk + character(len=chunkPos(myChunk*2+1)-chunkPos(myChunk*2)+1) :: IIO_stringValue + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - - IIO_stringValue = merge('',string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)),& - (myChunk > chunkPos(1) .or. myChunk < 1_pInt)) + IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) end function IIO_stringValue From 28414490c818eb696ee5a3d234c9fb587c13ebfc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 11 Jul 2018 05:12:49 +0200 Subject: [PATCH 045/208] following https://packaging.python.org/tutorials/packaging-projects --- lib/damask/__init__.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/damask/__init__.py b/lib/damask/__init__.py index 379b23547..9809ce5b2 100644 --- a/lib/damask/__init__.py +++ b/lib/damask/__init__.py @@ -6,6 +6,8 @@ import os with open(os.path.join(os.path.dirname(__file__),'../../VERSION')) as f: version = f.readline()[:-1] +name = 'damask' + from .environment import Environment # noqa from .asciitable import ASCIItable # noqa From f592881f67b97b8b5b9963c5dd039f9f525378b1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 12 Jul 2018 07:12:10 +0200 Subject: [PATCH 046/208] structured --- DAMASK_prerequisites.sh | 101 +++++++++++++++++----------------------- 1 file changed, 43 insertions(+), 58 deletions(-) diff --git a/DAMASK_prerequisites.sh b/DAMASK_prerequisites.sh index 4877d4b22..90289a2b8 100755 --- a/DAMASK_prerequisites.sh +++ b/DAMASK_prerequisites.sh @@ -12,21 +12,38 @@ echo + Send to damask@mpie.de for support echo + view with \'cat $OUTFILE\' echo =========================================== +function firstLevel { +echo -e '\n\n==============================================================================================' +echo $1 +echo ============================================================================================== +} + +function secondLevel { +echo ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +echo $1 +echo ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +} + +function thirdLevel { +echo ---------------------------------------------------------------------------------------------- +echo $1 +echo ---------------------------------------------------------------------------------------------- +} + function getDetails { if which $1 &> /dev/null; then - echo ---------------------------------------------------------------------------------------------- - echo $1: - echo ---------------------------------------------------------------------------------------------- + secondLevel $1: echo + location: which $1 echo + $1 $2: $1 $2 - echo -e '\n' else echo $1 not found fi +echo } + # redirect STDOUT and STDERR to logfile # https://stackoverflow.com/questions/11229385/redirect-all-output-in-a-bash-script-when-using-set-x^ exec > $OUTFILE 2>&1 @@ -38,28 +55,18 @@ DAMASK_ROOT="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" echo XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX echo System report for \'$(hostname)\' created on $(date '+%Y-%m-%d %H:%M:%S') by \'$(whoami)\' echo XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -echo -echo ============================================================================================== -echo DAMASK settings -echo ============================================================================================== -echo ---------------------------------------------------------------------------------------------- -echo DAMASK_ROOT: -echo ---------------------------------------------------------------------------------------------- + +firstLevel "DAMASK settings" +secondLevel "DAMASK_ROOT" echo $DAMASK_ROOT echo -echo ---------------------------------------------------------------------------------------------- -echo Version: -echo ---------------------------------------------------------------------------------------------- +secondLevel "Version" cat VERSION echo -echo ---------------------------------------------------------------------------------------------- -echo Settings in CONFIG: -echo ---------------------------------------------------------------------------------------------- +secondLevel "Settings in CONFIG" cat CONFIG -echo -echo ============================================================================================== -echo System -echo ============================================================================================== + +firstLevel "System" uname -a echo echo PATH: $PATH @@ -69,74 +76,52 @@ echo SHELL: $SHELL echo PETSC_ARCH: $PETSC_ARCH echo PETSC_DIR: $PETSC_DIR ls $PETSC_DIR/lib -echo -echo ============================================================================================== -echo Python -echo ============================================================================================== +firstLevel "Python" DEFAULT_PYTHON=python2.7 for executable in python python2 python3 python2.7; do getDetails $executable '--version' done -echo ---------------------------------------------------------------------------------------------- -echo Details on $DEFAULT_PYTHON: -echo ---------------------------------------------------------------------------------------------- +secondLevel "Details on $DEFAULT_PYTHON:" echo $(ls -la $(which $DEFAULT_PYTHON)) for module in numpy scipy;do - echo -e '\n----------------------------------------------------------------------------------------------' - echo $module - echo ---------------------------------------------------------------------------------------------- + thirdLevel $module $DEFAULT_PYTHON -c "import $module; \ print('Version: {}'.format($module.__version__)); \ print('Location: {}'.format($module.__file__))" done -echo ---------------------------------------------------------------------------------------------- -echo vtk -echo ---------------------------------------------------------------------------------------------- +thirdLevel vtk $DEFAULT_PYTHON -c "import vtk; \ print('Version: {}'.format(vtk.vtkVersion.GetVTKVersion())); \ print('Location: {}'.format(vtk.__file__))" -echo ---------------------------------------------------------------------------------------------- -echo h5py -echo ---------------------------------------------------------------------------------------------- +thirdLevel h5py $DEFAULT_PYTHON -c "import h5py; \ print('Version: {}'.format(h5py.version.version)); \ print('Location: {}'.format(h5py.__file__))" -echo -echo ============================================================================================== -echo GCC -echo ============================================================================================== + +firstLevel "GNU Compiler Collection" for executable in gcc g++ gfortran ;do getDetails $executable '--version' done -echo -echo ============================================================================================== -echo Intel Compiler Suite -echo ============================================================================================== + +firstLevel "Intel Compiler Suite" for executable in icc icpc ifort ;do getDetails $executable '--version' done -echo -echo ============================================================================================== -echo MPI Wrappers -echo ============================================================================================== + +firstLevel "MPI Wrappers" for executable in mpicc mpiCC mpic++ mpicpc mpicxx mpifort mpif90 mpif77; do getDetails $executable '-show' done -echo -echo ============================================================================================== -echo MPI Launchers -echo ============================================================================================== + +firstLevel "MPI Launchers" for executable in mpirun mpiexec; do getDetails $executable '--version' done -echo -echo ============================================================================================== -echo Abaqus -echo ============================================================================================== + +firstLevel "Abaqus" cd installation/mods_Abaqus # to have the right environment file for executable in abaqus abq2016 abq2017; do getDetails $executable 'information=all' done cd ../.. - From 6f3de6efe8d4b46d8c7747abeb5acfaafc8489bc Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 13 Jul 2018 19:06:38 +0200 Subject: [PATCH 047/208] [skip ci] updated version information after successful test of v2.0.2-228-ge08b7325 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index f889e902a..8a75e99ff 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-226-g6ed1e316 +v2.0.2-228-ge08b7325 From bc5fcf2c1426e63e4d24b7c08f387de72479ec95 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 10:51:42 +0200 Subject: [PATCH 048/208] leftover variable from cleaning --- src/debug.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/debug.f90 b/src/debug.f90 index ea2b659a1..55cc62ca0 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -283,11 +283,8 @@ end subroutine debug_reset subroutine debug_info implicit none - character(len=1) :: exceed - !$OMP CRITICAL (write2out) - debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 & .and. any(debug_stressMinLocation /= 0_pInt) & .and. any(debug_stressMaxLocation /= 0_pInt) ) then From 3f7a1d1c07ef3147d35cd04805e9abf7660f6eec Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 11:40:42 +0200 Subject: [PATCH 049/208] function to read and store complete text file reading as stream avoids costly repeated call to 'read'. Requires of course more memory, but that should be fine also, recursion case ('{}') is internally handled. Old recursive was error prone and buggy when rewining (see 'reset' option) --- src/IO.f90 | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/src/IO.f90 b/src/IO.f90 index a7e77f0f4..45c914587 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -22,6 +22,7 @@ module IO public :: & IO_init, & IO_read, & + IO_recursiveRead, & IO_checkAndRewind, & IO_open_file_stat, & IO_open_jobFile_stat, & @@ -100,6 +101,7 @@ end subroutine IO_init !-------------------------------------------------------------------------------------------------- !> @brief recursively reads a line from a text file. !! Recursion is triggered by "{path/to/inputfile}" in a line +!> @details unstable and buggy !-------------------------------------------------------------------------------------------------- recursive function IO_read(fileUnit,reset) result(line) @@ -170,6 +172,58 @@ recursive function IO_read(fileUnit,reset) result(line) end function IO_read +!-------------------------------------------------------------------------------------------------- +!> @brief recursively reads a text file. +!! Recursion is triggered by "{path/to/inputfile}" in a line +!-------------------------------------------------------------------------------------------------- +recursive function IO_recursiveRead(fileName) result(fileContent) + + implicit none + character(len=*), intent(in) :: fileName + character(len=1024), dimension(:), allocatable :: fileContent + character(len=1024), dimension(:), allocatable :: includedContent + character(len=1024) :: line + character(len=:), allocatable :: rawData + integer(pInt) :: fileLength, fileUnit,startPos,endPos,& + myTotalLines,l,includedLines, missingLines,i + + inquire(file = fileName, size=fileLength) + open(newunit=fileUnit, file = fileName, access = "STREAM") + allocate(character(len=fileLength)::rawData) + read(fileUnit) rawData + close(fileUnit) + + myTotalLines = 0 + do l=1, len(rawData) + if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1 + enddo + allocate(fileContent(myTotalLines)) + + startPos = 1 + endPos = 0 + + includedLines=0 + l=0 + do while (startPos <= len(rawData)) + l = l + 1 + endPos = endPos + scan(rawData(startPos:),new_line('')) + line = rawData(startPos:endPos-1) + startPos = endPos + 1 + + recursion: if(scan(trim(line),'{') < scan(trim(line),'}')) then + myTotalLines = myTotalLines - 1 + includedContent = IO_recursiveRead(trim(line(scan(line,'{')+1:scan(line,'}')-1))) + includedLines = includedLines +size(includedContent) + missingLines = myTotalLines+includedLines - size(fileContent(1:l-1)) -size(includedContent) + fileContent = [fileContent(1:l-1),includedContent,[(line,i=1,missingLines)]] + l=l-1+size(includedContent) + else recursion + fileContent(l) = line + endif recursion + + enddo + +end function IO_recursiveRead !-------------------------------------------------------------------------------------------------- !> @brief checks if unit is opened for reading, if true rewinds. Otherwise stops with From b26c4a39ef3ddbadfb5eb73136029e7d2634b0ab Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 11:42:58 +0200 Subject: [PATCH 050/208] store raw material.config --- src/config.f90 | 60 +++++++++++++++++++++++--------------------------- 1 file changed, 28 insertions(+), 32 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 9d2ddde4c..196a39be6 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -92,12 +92,12 @@ subroutine config_init() compiler_version, & compiler_options #endif + use DAMASK_interface, only: & + getSolverJobName use IO, only: & IO_error, & - IO_open_file, & - IO_read, & IO_lc, & - IO_open_jobFile_stat, & + IO_recursiveRead, & IO_getTag, & IO_timeStamp, & IO_EOF @@ -107,12 +107,13 @@ subroutine config_init() debug_levelBasic implicit none - integer(pInt), parameter :: FILEUNIT = 200_pInt - integer(pInt) :: myDebug + integer(pInt) :: myDebug,i character(len=65536) :: & line, & part + character(len=65536), dimension(:), allocatable :: fileContent + logical :: jobSpecificConfig write(6,'(/,a)') ' <<<+- config init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -120,42 +121,42 @@ subroutine config_init() myDebug = debug_level(debug_material) - if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... - call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file + inquire(file=trim(getSolverJobName())//'.'//material_localFileExt,exist=jobSpecificConfig) + if(jobSpecificConfig) then + fileContent = IO_recursiveRead(trim(getSolverJobName())//'.'//material_localFileExt) + else + fileContent = IO_recursiveRead('material.config') + endif - rewind(fileUnit) - line = '' ! to have it initialized - do while (trim(line) /= IO_EOF) + do i=1, size(fileContent) + line = trim(fileContent(i)) part = IO_lc(IO_getTag(line,'<','>')) - select case (trim(part)) case (trim(material_partPhase)) - call parseFile(line,phase_name,config_phase,FILEUNIT) + call parseFile(line,phase_name,config_phase,fileContent(i+1:)) !(i+1:) save for empty part at (at end of file)? if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) case (trim(material_partMicrostructure)) - call parseFile(line,microstructure_name,config_microstructure,FILEUNIT) + call parseFile(line,microstructure_name,config_microstructure,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) case (trim(material_partCrystallite)) - call parseFile(line,crystallite_name,config_crystallite,FILEUNIT) + call parseFile(line,crystallite_name,config_crystallite,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) case (trim(material_partHomogenization)) - call parseFile(line,homogenization_name,config_homogenization,FILEUNIT) + call parseFile(line,homogenization_name,config_homogenization,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) case (trim(material_partTexture)) - call parseFile(line,texture_name,config_texture,FILEUNIT) + call parseFile(line,texture_name,config_texture,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) - case default - line = IO_read(fileUnit) - end select enddo + deallocate(fileContent) material_Nhomogenization = size(config_homogenization) if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) @@ -174,25 +175,23 @@ end subroutine config_init !> @brief parses the material.config file !-------------------------------------------------------------------------------------------------- subroutine parseFile(line,& - sectionNames,part,fileUnit) + sectionNames,part,fileContent) use IO, only: & - IO_read, & IO_error, & IO_lc, & IO_getTag, & IO_isBlank, & IO_stringValue, & - IO_stringPos, & - IO_EOF + IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames - type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part + type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part + character(len=65536), dimension(:), intent(in) :: fileContent character(len=65536),intent(out) :: line integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: s + integer(pInt) :: s,i character(len=65536) :: devNull character(len=64) :: tag logical :: echo @@ -201,13 +200,10 @@ subroutine parseFile(line,& allocate(part(0)) s = 0_pInt - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) + do i=1, size(fileContent) + line = trim(fileContent(i)) if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read to close any recursively included files - exit - endif foundNextPart + if (IO_getTag(line,'<','>') /= '') exit nextSection: if (IO_getTag(line,'[',']') /= '') then s = s + 1_pInt part = [part, emptyList] From 7f05bf9c0a49d22de2a1f2cafa7a5ccbf905f291 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 11:54:46 +0200 Subject: [PATCH 051/208] leftover variables not needed anymore --- PRIVATE | 2 +- src/crystallite.f90 | 8 +------- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/PRIVATE b/PRIVATE index d1d465808..4d3d6d517 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit d1d46580823d2896059b9514ddc975f9fe5f6b1f +Subproject commit 4d3d6d517171b7c22295896c1c4358238fe6d05d diff --git a/src/crystallite.f90 b/src/crystallite.f90 index aea4fb993..0ee71b5de 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -494,7 +494,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) subStepMinCryst, & subStepSizeCryst, & stepIncreaseCryst, & - nCryst, & numerics_integrator, & numerics_integrationMode, & numerics_timeSyncing @@ -1215,8 +1214,6 @@ end subroutine crystallite_stressAndItsTangent subroutine crystallite_integrateStateRK4() use, intrinsic :: & IEEE_arithmetic - use numerics, only: & - numerics_integrationMode use debug, only: & #ifdef DEBUG debug_e, & @@ -1517,8 +1514,7 @@ subroutine crystallite_integrateStateRKCK45() debug_levelExtensive, & debug_levelSelective use numerics, only: & - rTol_crystalliteState, & - numerics_integrationMode + rTol_crystalliteState use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -2581,7 +2577,6 @@ subroutine crystallite_integrateStateFPI() debug_levelSelective use numerics, only: & nState, & - numerics_integrationMode, & rTol_crystalliteState use FEsolving, only: & FEsolving_execElem, & @@ -3156,7 +3151,6 @@ logical function crystallite_integrateStress(& aTol_crystalliteStress, & rTol_crystalliteStress, & iJacoLpresiduum, & - numerics_integrationMode, & subStepSizeLp, & subStepSizeLi use debug, only: debug_level, & From a1ad18c88ae2caed603962ecfa06cfdf9ec64558 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 12:08:22 +0200 Subject: [PATCH 052/208] 256 characters is enough for material.config larger values waste memory and decrease readability. Still need to discuss how geom files are handled, for them longer limits make sense --- src/IO.f90 | 7 ++++--- src/config.f90 | 9 ++++----- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 45c914587..67130ed91 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -180,9 +180,9 @@ recursive function IO_recursiveRead(fileName) result(fileContent) implicit none character(len=*), intent(in) :: fileName - character(len=1024), dimension(:), allocatable :: fileContent - character(len=1024), dimension(:), allocatable :: includedContent - character(len=1024) :: line + character(len=256), dimension(:), allocatable :: fileContent + character(len=256), dimension(:), allocatable :: includedContent + character(len=256) :: line character(len=:), allocatable :: rawData integer(pInt) :: fileLength, fileUnit,startPos,endPos,& myTotalLines,l,includedLines, missingLines,i @@ -207,6 +207,7 @@ recursive function IO_recursiveRead(fileName) result(fileContent) do while (startPos <= len(rawData)) l = l + 1 endPos = endPos + scan(rawData(startPos:),new_line('')) + if(endPos - startPos >256) write(6,*) 'mist' line = rawData(startPos:endPos-1) startPos = endPos + 1 diff --git a/src/config.f90 b/src/config.f90 index 196a39be6..022247aeb 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -109,10 +109,10 @@ subroutine config_init() implicit none integer(pInt) :: myDebug,i - character(len=65536) :: & + character(len=256) :: & line, & part - character(len=65536), dimension(:), allocatable :: fileContent + character(len=256), dimension(:), allocatable :: fileContent logical :: jobSpecificConfig write(6,'(/,a)') ' <<<+- config init -+>>>' @@ -187,12 +187,11 @@ subroutine parseFile(line,& implicit none character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part - character(len=65536), dimension(:), intent(in) :: fileContent - character(len=65536),intent(out) :: line + character(len=256), dimension(:), intent(in) :: fileContent + character(len=256),intent(out) :: line integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: s,i - character(len=65536) :: devNull character(len=64) :: tag logical :: echo From fb1265db3d43db3412a407a579aefb43fa5da7b8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 20:08:31 +0200 Subject: [PATCH 053/208] checking for existing file --- src/config.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/config.f90 b/src/config.f90 index 022247aeb..86b1bc501 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -125,6 +125,8 @@ subroutine config_init() if(jobSpecificConfig) then fileContent = IO_recursiveRead(trim(getSolverJobName())//'.'//material_localFileExt) else + inquire(file='material.config',exist=jobSpecificConfig) + if(.not. jobSpecificConfig) call IO_error(0_pInt) fileContent = IO_recursiveRead('material.config') endif From edcf97ea59204cdde9a35eeb495b4d7bd5b44ffa Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 22:02:31 +0200 Subject: [PATCH 054/208] associate: clearer code and no performance drawbacks --- src/plastic_phenopowerlaw.f90 | 46 ++++++++++++++++------------------- 1 file changed, 21 insertions(+), 25 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index d7be6a44b..f854e7b00 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -61,7 +61,7 @@ module plastic_phenopowerlaw tau0_twin, & !< initial critical shear stress for twin tausat_slip, & !< maximum critical shear stress for slip nonSchmidCoeff, & - H_int !< per family hardening activity (optional) + H_int !< per family hardening activity (optional) real(pReal), dimension(:,:), allocatable :: & interaction_SlipSlip, & !< slip resistance from slip activity interaction_SlipTwin, & !< slip resistance from twin activity @@ -69,10 +69,10 @@ module plastic_phenopowerlaw interaction_TwinTwin !< twin resistance from twin activity integer(kind(undefined_ID)), dimension(:), allocatable :: & - outputID !< ID of each post result output + outputID !< ID of each post result output end type - type(tParameters), dimension(:), allocatable, target, private :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) type, private :: tPhenopowerlawState real(pReal), pointer, dimension(:,:) :: & @@ -154,7 +154,7 @@ subroutine plastic_phenopowerlaw_init real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - type(tParameters), pointer :: prm + type(tParameters) :: prm integer(kind(undefined_ID)) :: & outputID !< ID of each post result output @@ -182,7 +182,7 @@ subroutine plastic_phenopowerlaw_init do p = 1_pInt, size(phase_plasticityInstance) if (phase_plasticity(p) /= PLASTICITY_PHENOPOWERLAW_ID) cycle instance = phase_plasticityInstance(p) - prm => param(instance) + associate(prm => param(instance)) prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) if (size(prm%Nslip) > count(lattice_NslipSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') @@ -457,7 +457,8 @@ subroutine plastic_phenopowerlaw_init plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear dotState(instance)%whole =>plasticState(p)%dotState - + + end associate enddo end subroutine plastic_phenopowerlaw_init @@ -511,14 +512,13 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor real(pReal), dimension(3,3,2) :: & nonSchmid_tensor - type(tParameters), pointer :: prm - type(tPhenopowerlawState), pointer :: stt + type(tParameters) :: prm + type(tPhenopowerlawState) :: stt of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - prm => param(phase_plasticityInstance(ph)) - stt => state(phase_plasticityInstance(ph)) + associate(prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph))) Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal @@ -603,7 +603,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) - + end associate end subroutine plastic_phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- @@ -644,15 +644,13 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & gdot_twin - type(tParameters), pointer :: prm - type(tPhenopowerlawState), pointer :: dst,stt + type(tParameters) :: prm + type(tPhenopowerlawState) :: dst,stt of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - - prm => param(phase_plasticityInstance(ph)) - stt => state(phase_plasticityInstance(ph)) - dst => dotState(phase_plasticityInstance(ph)) + associate( prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph)), dst => & +dotState(phase_plasticityInstance(ph))) dst%whole(:,of) = 0.0_pReal @@ -729,7 +727,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) dst%accshear_twin(j,of) = abs(gdot_twin(j)) enddo twinSystems2 enddo twinFamilies2 - + end associate end subroutine plastic_phenopowerlaw_dotState @@ -767,16 +765,14 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) real(pReal) :: & tau_slip_pos,tau_slip_neg,tau - type(tParameters), pointer :: prm - type(tPhenopowerlawState), pointer :: stt, dst + type(tParameters) :: prm + type(tPhenopowerlawState) :: stt, dst of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - stt => state(phase_plasticityInstance(ph)) - dst => dotstate(phase_plasticityInstance(ph)) - prm => param(phase_plasticityInstance(ph)) - + associate( prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph)), dst => & +dotState(phase_plasticityInstance(ph))) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt @@ -872,7 +868,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) end select enddo outputsLoop - + end associate end function plastic_phenopowerlaw_postResults end module plastic_phenopowerlaw From ef6ffc94e7f4cdcbea618b1b0a93f189effaf47a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 18 Jul 2018 23:40:49 +0200 Subject: [PATCH 055/208] simplified system report --- DAMASK_prerequisites.sh | 4 ++-- PRIVATE | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DAMASK_prerequisites.sh b/DAMASK_prerequisites.sh index 90289a2b8..b5acede32 100755 --- a/DAMASK_prerequisites.sh +++ b/DAMASK_prerequisites.sh @@ -25,7 +25,7 @@ echo +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ } function thirdLevel { -echo ---------------------------------------------------------------------------------------------- +echo -e '\n----------------------------------------------------------------------------------------------' echo $1 echo ---------------------------------------------------------------------------------------------- } @@ -121,7 +121,7 @@ done firstLevel "Abaqus" cd installation/mods_Abaqus # to have the right environment file -for executable in abaqus abq2016 abq2017; do +for executable in abaqus abq2017 abq2018; do getDetails $executable 'information=all' done cd ../.. diff --git a/PRIVATE b/PRIVATE index d1d465808..0c9db9b75 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit d1d46580823d2896059b9514ddc975f9fe5f6b1f +Subproject commit 0c9db9b7542e7e1c3cac96e4821be9d9a7505a9d From a3682d4876b9c3399ef36dfc6229390aca00cc1c Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 19 Jul 2018 06:58:39 +0200 Subject: [PATCH 056/208] [skip ci] updated version information after successful test of v2.0.2-232-gef6ffc94 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 8a75e99ff..1779757ff 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-228-ge08b7325 +v2.0.2-232-gef6ffc94 From beb418eb4499c15e312da70589c48e89d427b9ce Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 19 Jul 2018 15:20:34 +0200 Subject: [PATCH 057/208] python3 compatible way ugly, but works also for python2.7. Probably there is a better solution when 2.7 is deprecated --- lib/damask/util.py | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/damask/util.py b/lib/damask/util.py index 413f955e9..fde9b35a3 100644 --- a/lib/damask/util.py +++ b/lib/damask/util.py @@ -59,9 +59,9 @@ def report_geom(info, what = ['grid','size','origin','homogenization','microstructures']): """Reports (selected) geometry information""" output = { - 'grid' : 'grid a b c: {}'.format(' x '.join(map(str,info['grid' ]))), - 'size' : 'size x y z: {}'.format(' x '.join(map(str,info['size' ]))), - 'origin' : 'origin x y z: {}'.format(' : '.join(map(str,info['origin']))), + 'grid' : 'grid a b c: {}'.format(' x '.join(list(map(str,info['grid' ])))), + 'size' : 'size x y z: {}'.format(' x '.join(list(map(str,info['size' ])))), + 'origin' : 'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))), 'homogenization' : 'homogenization: {}'.format(info['homogenization']), 'microstructures' : 'microstructures: {}'.format(info['microstructures']), } @@ -103,9 +103,9 @@ def coordGridAndSize(coordinates): """Determines grid count and overall physical size along each dimension of an ordered array of coordinates""" dim = coordinates.shape[1] coords = [np.unique(coordinates[:,i]) for i in range(dim)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') + mincorner = np.array(list(map(min,coords))) + maxcorner = np.array(list(map(max,coords))) + grid = np.array(list(map(len,coords)),'i') size = grid/np.maximum(np.ones(dim,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 equal to smallest among other ones return grid,size From 6dd970dfe01b7b243f57456b113b65a876aeff56 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 19 Jul 2018 15:46:14 +0200 Subject: [PATCH 058/208] logic seemed to be broken (only filter out strings which have a 'strip' attribute string in python 3 have both attributes, '__iter__' and '__getitem'. Old syntax therefore split up strings into characters --- lib/damask/util.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/damask/util.py b/lib/damask/util.py index fde9b35a3..93387205e 100644 --- a/lib/damask/util.py +++ b/lib/damask/util.py @@ -36,8 +36,8 @@ class bcolors: def srepr(arg,glue = '\n'): """Joins arguments as individual lines""" if (not hasattr(arg, "strip") and - hasattr(arg, "__getitem__") or - hasattr(arg, "__iter__")): + (hasattr(arg, "__getitem__") or + hasattr(arg, "__iter__"))): return glue.join(str(x) for x in arg) return arg if isinstance(arg,str) else repr(arg) From d138993c1d8212608637b62a9f265a6df897d21d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 19 Jul 2018 16:12:36 +0200 Subject: [PATCH 059/208] using util functionality to be compatible with python3 --- processing/post/addCompatibilityMismatch.py | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/processing/post/addCompatibilityMismatch.py b/processing/post/addCompatibilityMismatch.py index 51e5f5eab..b798acdbd 100755 --- a/processing/post/addCompatibilityMismatch.py +++ b/processing/post/addCompatibilityMismatch.py @@ -282,19 +282,12 @@ for name in filenames: table.data_readArray([options.defgrad,options.pos]) table.data_rewind() - if len(table.data.shape) < 2: table.data.shape += (1,) # expand to 2D shape if table.data[:,9:].shape[1] < 3: table.data = np.hstack((table.data, np.zeros((table.data.shape[0], 3-table.data[:,9:].shape[1]),dtype='f'))) # fill coords up to 3D with zeros - coords = [np.unique(table.data[:,9+i]) for i in range(3)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') - size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) - size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings - + grid,size = damask.util.coordGridAndSize(table.data[:,9:12]) N = grid.prod() if N != len(table.data): errors.append('data count {} does not match grid {}x{}x{}.'.format(N,*grid)) From 9821654aae448686d1fe43785839b546b7a9b02c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 19 Jul 2018 16:16:10 +0200 Subject: [PATCH 060/208] iteritems does not exist in python3 anymore items also works for python2 (might be slower though) --- processing/post/addDeterminant.py | 4 ++-- processing/post/addDeviator.py | 6 +++--- processing/post/addGaussian.py | 6 +++--- processing/post/addMises.py | 4 ++-- processing/post/addSpectralDecomposition.py | 4 ++-- processing/post/addStrainTensors.py | 2 +- processing/post/rotateData.py | 2 +- processing/pre/geom_translate.py | 2 +- processing/pre/patchFromReconstructedBoundaries.py | 2 +- 9 files changed, 16 insertions(+), 16 deletions(-) diff --git a/processing/post/addDeterminant.py b/processing/post/addDeterminant.py index 1f721c27e..7196051e5 100755 --- a/processing/post/addDeterminant.py +++ b/processing/post/addDeterminant.py @@ -58,7 +58,7 @@ for name in filenames: errors = [] remarks = [] - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type)) @@ -81,7 +81,7 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - for type, data in items.iteritems(): + for type, data in items.items(): for column in data['column']: table.data_append(determinant(map(float,table.data[column: column+data['dim']]))) diff --git a/processing/post/addDeviator.py b/processing/post/addDeviator.py index 471c2635f..4df8a6803 100755 --- a/processing/post/addDeviator.py +++ b/processing/post/addDeviator.py @@ -66,7 +66,7 @@ for name in filenames: remarks = [] column = {} - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}.'.format(what,type)) @@ -83,7 +83,7 @@ for name in filenames: # ------------------------------------------ assemble header -------------------------------------- table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) - for type, data in items.iteritems(): + for type, data in items.items(): for label in data['active']: table.labels_append(['{}_dev({})'.format(i+1,label) for i in range(data['dim'])] + \ (['sph({})'.format(label)] if options.spherical else [])) # extend ASCII header with new labels @@ -93,7 +93,7 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - for type, data in items.iteritems(): + for type, data in items.items(): for column in data['column']: table.data_append(deviator(map(float,table.data[column: column+data['dim']]),options.spherical)) diff --git a/processing/post/addGaussian.py b/processing/post/addGaussian.py index c198ef62f..bc0100f56 100755 --- a/processing/post/addGaussian.py +++ b/processing/post/addGaussian.py @@ -83,7 +83,7 @@ for name in filenames: if table.label_dimension(options.pos) != 3: errors.append('coordinates {} are not a vector.'.format(options.pos)) else: colCoord = table.label_index(options.pos) - for type, data in items.iteritems(): + for type, data in items.items(): for what in (data['labels'] if data['labels'] is not None else []): dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}.'.format(what,type)) @@ -100,7 +100,7 @@ for name in filenames: # ------------------------------------------ assemble header -------------------------------------- table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) - for type, data in items.iteritems(): + for type, data in items.items(): for label in data['active']: table.labels_append(['Gauss{}({})'.format(options.sigma,label)]) # extend ASCII header with new labels table.head_write() @@ -114,7 +114,7 @@ for name in filenames: # ------------------------------------------ process value field ----------------------------------- stack = [table.data] - for type, data in items.iteritems(): + for type, data in items.items(): for i,label in enumerate(data['active']): stack.append(ndimage.filters.gaussian_filter(table.data[:,data['column'][i]], options.sigma,options.order, diff --git a/processing/post/addMises.py b/processing/post/addMises.py index 2ce350dbd..4719c2e35 100755 --- a/processing/post/addMises.py +++ b/processing/post/addMises.py @@ -70,7 +70,7 @@ for name in filenames: errors = [] remarks = [] - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type)) @@ -94,7 +94,7 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - for type, data in items.iteritems(): + for type, data in items.items(): for column in data['column']: table.data_append(Mises(type, np.array(table.data[column:column+data['dim']],'d').reshape(data['shape']))) diff --git a/processing/post/addSpectralDecomposition.py b/processing/post/addSpectralDecomposition.py index 76bf2e875..b21900c0c 100755 --- a/processing/post/addSpectralDecomposition.py +++ b/processing/post/addSpectralDecomposition.py @@ -58,7 +58,7 @@ for name in filenames: errors = [] remarks = [] - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type)) @@ -84,7 +84,7 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - for type, data in items.iteritems(): + for type, data in items.items(): for column in data['column']: (u,v) = np.linalg.eigh(np.array(map(float,table.data[column:column+data['dim']])).reshape(data['shape'])) if options.rh and np.dot(np.cross(v[:,0], v[:,1]), v[:,2]) < 0.0 : v[:, 2] *= -1.0 # ensure right-handed eigenvector basis diff --git a/processing/post/addStrainTensors.py b/processing/post/addStrainTensors.py index 447ae03ba..7cb9f3079 100755 --- a/processing/post/addStrainTensors.py +++ b/processing/post/addStrainTensors.py @@ -101,7 +101,7 @@ for name in filenames: errors = [] remarks = [] - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type)) diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 08958cc86..c5e4882b9 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -73,7 +73,7 @@ for name in filenames: remarks = [] column = {} - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}.'.format(what,type)) diff --git a/processing/pre/geom_translate.py b/processing/pre/geom_translate.py index f8f6e4169..2f4918632 100755 --- a/processing/pre/geom_translate.py +++ b/processing/pre/geom_translate.py @@ -92,7 +92,7 @@ for name in filenames: } substituted = np.copy(microstructure) - for k, v in sub.iteritems(): substituted[microstructure==k] = v # substitute microstructure indices + for k, v in sub.items(): substituted[microstructure==k] = v # substitute microstructure indices substituted += options.microstructure # shift microstructure indices diff --git a/processing/pre/patchFromReconstructedBoundaries.py b/processing/pre/patchFromReconstructedBoundaries.py index a43ccc236..fabec0fdf 100755 --- a/processing/pre/patchFromReconstructedBoundaries.py +++ b/processing/pre/patchFromReconstructedBoundaries.py @@ -344,7 +344,7 @@ def rcbParser(content,M,size,tolerance,idcolumn,segmentcolumn): else: myNeighbors[grainNeighbors[leg][side]] = 1 if myNeighbors: # do I have any neighbors (i.e., non-bounding box segment) - candidateGrains = sorted(myNeighbors.iteritems(), key=lambda p: (p[1],p[0]), reverse=True) # sort grain counting + candidateGrains = sorted(myNeighbors.items(), key=lambda p: (p[1],p[0]), reverse=True) # sort grain counting # most frequent one not yet seen? rcData['grainMapping'].append(candidateGrains[0 if candidateGrains[0][0] not in rcData['grainMapping'] else 1][0]) # must be me then # special case of bi-crystal situation... From 35e470ff4d500a81587c764f94f5146e5547b00d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 19 Jul 2018 16:19:05 +0200 Subject: [PATCH 061/208] needed for python3 --- processing/post/addCauchy.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/processing/post/addCauchy.py b/processing/post/addCauchy.py index a21d91064..43717c975 100755 --- a/processing/post/addCauchy.py +++ b/processing/post/addCauchy.py @@ -75,8 +75,8 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - F = np.array(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9]),'d').reshape(3,3) - P = np.array(map(float,table.data[column[options.stress ]:column[options.stress ]+9]),'d').reshape(3,3) + F = np.array(list(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9])),'d').reshape(3,3) + P = np.array(list(map(float,table.data[column[options.stress ]:column[options.stress ]+9])),'d').reshape(3,3) table.data_append(list(1.0/np.linalg.det(F)*np.dot(P,F.T).reshape(9))) # [Cauchy] = (1/det(F)) * [P].[F_transpose] outputAlive = table.data_write() # output processed line From f928bd5e5b3d958b885891555978000e4e413345 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 19 Jul 2018 16:26:30 +0200 Subject: [PATCH 062/208] more python 3 compatibility --- processing/post/addDeterminant.py | 5 ++--- processing/post/addDeviator.py | 4 ++-- processing/post/addDisplacement.py | 8 +------- processing/post/addEhkl.py | 4 ++-- processing/post/addEuclideanDistance.py | 10 ++-------- 5 files changed, 9 insertions(+), 22 deletions(-) diff --git a/processing/post/addDeterminant.py b/processing/post/addDeterminant.py index 7196051e5..6d992b6f5 100755 --- a/processing/post/addDeterminant.py +++ b/processing/post/addDeterminant.py @@ -83,10 +83,9 @@ for name in filenames: while outputAlive and table.data_read(): # read next data line of ASCII table for type, data in items.items(): for column in data['column']: - table.data_append(determinant(map(float,table.data[column: - column+data['dim']]))) + table.data_append(determinant(list(map(float,table.data[column: column+data['dim']])))) outputAlive = table.data_write() # output processed line # ------------------------------------------ output finalization ----------------------------------- - table.close() # close input ASCII table (works for stdin) \ No newline at end of file + table.close() # close input ASCII table (works for stdin) diff --git a/processing/post/addDeviator.py b/processing/post/addDeviator.py index 4df8a6803..86fcac509 100755 --- a/processing/post/addDeviator.py +++ b/processing/post/addDeviator.py @@ -95,8 +95,8 @@ for name in filenames: while outputAlive and table.data_read(): # read next data line of ASCII table for type, data in items.items(): for column in data['column']: - table.data_append(deviator(map(float,table.data[column: - column+data['dim']]),options.spherical)) + table.data_append(deviator(list(map(float,table.data[column: + column+data['dim']])),options.spherical)) outputAlive = table.data_write() # output processed line # ------------------------------------------ output finalization ----------------------------------- diff --git a/processing/post/addDisplacement.py b/processing/post/addDisplacement.py index bc1d7377b..00132d7c6 100755 --- a/processing/post/addDisplacement.py +++ b/processing/post/addDisplacement.py @@ -168,13 +168,7 @@ for name in filenames: np.zeros((table.data.shape[0], 3-table.data[:,9:].shape[1]),dtype='f'))) # fill coords up to 3D with zeros - coords = [np.unique(table.data[:,9+i]) for i in range(3)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') - size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) - size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings - + grid,size = damask.util.coordGridAndSize(table.data[:,9:12]) N = grid.prod() if N != len(table.data): errors.append('data count {} does not match grid {}x{}x{}.'.format(N,*grid)) diff --git a/processing/post/addEhkl.py b/processing/post/addEhkl.py index f7a143466..59f678118 100755 --- a/processing/post/addEhkl.py +++ b/processing/post/addEhkl.py @@ -88,9 +88,9 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table for column in columns: - table.data_append(E_hkl(map(float,table.data[column:column+3]),options.hkl)) + table.data_append(E_hkl(list(map(float,table.data[column:column+3])),options.hkl)) outputAlive = table.data_write() # output processed line # ------------------------------------------ output finalization ----------------------------------- - table.close() # close ASCII tables \ No newline at end of file + table.close() # close ASCII tables diff --git a/processing/post/addEuclideanDistance.py b/processing/post/addEuclideanDistance.py index b83c36b6c..b3f972fc7 100755 --- a/processing/post/addEuclideanDistance.py +++ b/processing/post/addEuclideanDistance.py @@ -151,10 +151,8 @@ for name in filenames: remarks = [] column = {} - coordDim = table.label_dimension(options.pos) - if not 3 >= coordDim >= 1: + if not 3 >= table.label_dimension(options.pos) >= 1: errors.append('coordinates "{}" need to have one, two, or three dimensions.'.format(options.pos)) - else: coordCol = table.label_index(options.pos) if table.label_dimension(options.id) != 1: errors.append('grain identifier {} not found.'.format(options.id)) else: idCol = table.label_index(options.id) @@ -178,11 +176,7 @@ for name in filenames: table.data_readArray() - coords = [np.unique(table.data[:,coordCol+i]) for i in range(coordDim)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords)+[1]*(3-len(coords)),'i') - + grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) N = grid.prod() if N != len(table.data): errors.append('data count {} does not match grid {}.'.format(N,'x'.join(map(str,grid)))) From 0438b7113a791dc9b08154da11bdda9893a7feb4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 19 Jul 2018 16:34:04 +0200 Subject: [PATCH 063/208] using util function where possible, ensuring python3 compatibility --- processing/post/addPole.py | 12 ++++++------ processing/post/averageDown.py | 25 ++++++++----------------- processing/post/blowUp.py | 10 ++-------- 3 files changed, 16 insertions(+), 31 deletions(-) diff --git a/processing/post/addPole.py b/processing/post/addPole.py index 10c5cce67..95bc87637 100755 --- a/processing/post/addPole.py +++ b/processing/post/addPole.py @@ -120,15 +120,15 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table if inputtype == 'eulers': - o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians) + o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians) elif inputtype == 'matrix': - o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose()) + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose()) elif inputtype == 'frame': - o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \ - table.data[column[1]:column[1]+3] + \ - table.data[column[2]:column[2]+3])).reshape(3,3)) + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \ + table.data[column[1]:column[1]+3] + \ + table.data[column[2]:column[2]+3]))).reshape(3,3)) elif inputtype == 'quaternion': - o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4]))) + o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4])))) rotatedPole = o.quaternion*pole # rotate pole according to crystal orientation (x,y) = rotatedPole[0:2]/(1.+abs(pole[2])) # stereographic projection diff --git a/processing/post/averageDown.py b/processing/post/averageDown.py index 886083428..501ca3b3c 100755 --- a/processing/post/averageDown.py +++ b/processing/post/averageDown.py @@ -76,7 +76,6 @@ for name in filenames: remarks = [] if table.label_dimension(options.pos) != 3: errors.append('coordinates {} are not a vector.'.format(options.pos)) - else: colCoord = table.label_index(options.pos) if remarks != []: damask.util.croak(remarks) if errors != []: @@ -94,14 +93,7 @@ for name in filenames: table.data_readArray() if (any(options.grid) == 0 or any(options.size) == 0.0): - coords = [np.unique(table.data[:,colCoord+i]) for i in range(3)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') - size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) - size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings - delta = size/np.maximum(np.ones(3,'d'), grid) - origin = mincorner - 0.5*delta # shift from cell center to corner + grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) else: grid = np.array(options.grid,'i') @@ -129,16 +121,15 @@ for name in filenames: #--- generate grid -------------------------------------------------------------------------------- - if colCoord: - x = (0.5 + shift[0] + np.arange(packedGrid[0],dtype=float))/packedGrid[0]*size[0] + origin[0] - y = (0.5 + shift[1] + np.arange(packedGrid[1],dtype=float))/packedGrid[1]*size[1] + origin[1] - z = (0.5 + shift[2] + np.arange(packedGrid[2],dtype=float))/packedGrid[2]*size[2] + origin[2] + x = (0.5 + shift[0] + np.arange(packedGrid[0],dtype=float))/packedGrid[0]*size[0] + origin[0] + y = (0.5 + shift[1] + np.arange(packedGrid[1],dtype=float))/packedGrid[1]*size[1] + origin[1] + z = (0.5 + shift[2] + np.arange(packedGrid[2],dtype=float))/packedGrid[2]*size[2] + origin[2] - xx = np.tile( x, packedGrid[1]* packedGrid[2]) - yy = np.tile(np.repeat(y,packedGrid[0] ),packedGrid[2]) - zz = np.repeat(z,packedGrid[0]*packedGrid[1]) + xx = np.tile( x, packedGrid[1]* packedGrid[2]) + yy = np.tile(np.repeat(y,packedGrid[0] ),packedGrid[2]) + zz = np.repeat(z,packedGrid[0]*packedGrid[1]) - table.data[:,colCoord:colCoord+3] = np.squeeze(np.dstack((xx,yy,zz))) + table.data[:,table.label_indexragen(options.pos)] = np.squeeze(np.dstack((xx,yy,zz))) # ------------------------------------------ output result ----------------------------------------- diff --git a/processing/post/blowUp.py b/processing/post/blowUp.py index 0642deab1..5a0d631e0 100755 --- a/processing/post/blowUp.py +++ b/processing/post/blowUp.py @@ -64,7 +64,6 @@ for name in filenames: remarks = [] if table.label_dimension(options.pos) != 3: errors.append('coordinates "{}" are not a vector.'.format(options.pos)) - else: colCoord = table.label_index(options.pos) colElem = table.label_index('elem') @@ -79,12 +78,7 @@ for name in filenames: table.data_readArray(options.pos) table.data_rewind() - coords = [np.unique(table.data[:,i]) for i in range(3)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') - size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) - size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings + grid,size = damask.util.coordGridAndSize(table.data) packing = np.array(options.packing,'i') outSize = grid*packing @@ -113,7 +107,7 @@ for name in filenames: for c in range(outSize[2]): for b in range(outSize[1]): for a in range(outSize[0]): - data[a,b,c,colCoord:colCoord+3] = [a+0.5,b+0.5,c+0.5]*elementSize + data[a,b,c,table.label_indexrange(options.pos)] = [a+0.5,b+0.5,c+0.5]*elementSize if colElem != -1: data[a,b,c,colElem] = elem table.data = data[a,b,c,:].tolist() outputAlive = table.data_write() # output processed line From 1f637a0c49bf3cb8022b27bb7ac6cf6412eb6e99 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 19 Jul 2018 16:53:48 +0200 Subject: [PATCH 064/208] python3 compatible map requires conversion to list --- processing/post/addEuclideanDistance.py | 2 +- processing/post/addIPFcolor.py | 10 +++++----- processing/post/addOrientations.py | 16 ++++++++-------- processing/post/addPK2.py | 4 ++-- processing/post/addSchmidfactors.py | 12 ++++++------ processing/post/addSpectralDecomposition.py | 2 +- processing/post/addStrainTensors.py | 2 +- processing/post/rotateData.py | 4 ++-- processing/post/vtk2ang.py | 2 -- processing/post/vtk_rectilinearGrid.py | 2 +- 10 files changed, 27 insertions(+), 29 deletions(-) diff --git a/processing/post/addEuclideanDistance.py b/processing/post/addEuclideanDistance.py index b3f972fc7..d99eaaa8c 100755 --- a/processing/post/addEuclideanDistance.py +++ b/processing/post/addEuclideanDistance.py @@ -102,7 +102,7 @@ parser.add_option('-t', help = 'feature type {{{}}} '.format(', '.join(map(lambda x:'/'.join(x['names']),features))) ) parser.add_option('-n', '--neighborhood', - dest = 'neighborhood', choices = neighborhoods.keys(), metavar = 'string', + dest = 'neighborhood', choices = list(neighborhoods.keys()), metavar = 'string', help = 'neighborhood type [neumann] {{{}}}'.format(', '.join(neighborhoods.keys()))) parser.add_option('-s', '--scale', diff --git a/processing/post/addIPFcolor.py b/processing/post/addIPFcolor.py index 2fcc000e1..fd93b45a0 100755 --- a/processing/post/addIPFcolor.py +++ b/processing/post/addIPFcolor.py @@ -116,18 +116,18 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table if inputtype == 'eulers': - o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians, + o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians, symmetry = options.symmetry).reduced() elif inputtype == 'matrix': - o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose(), + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose(), symmetry = options.symmetry).reduced() elif inputtype == 'frame': - o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \ + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \ table.data[column[1]:column[1]+3] + \ - table.data[column[2]:column[2]+3])).reshape(3,3), + table.data[column[2]:column[2]+3]))).reshape(3,3), symmetry = options.symmetry).reduced() elif inputtype == 'quaternion': - o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4])), + o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))), symmetry = options.symmetry).reduced() table.data_append(o.IPFcolor(pole)) diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index dc23b351e..e7948c842 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -80,7 +80,7 @@ parser.set_defaults(output = [], (options, filenames) = parser.parse_args() -options.output = map(lambda x: x.lower(), options.output) +options.output = list(map(lambda x: x.lower(), options.output)) if options.output == [] or (not set(options.output).issubset(set(outputChoices))): parser.error('output must be chosen from {}.'.format(', '.join(outputChoices))) @@ -147,21 +147,21 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table if inputtype == 'eulers': - o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians, + o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians, symmetry = options.symmetry).reduced() elif inputtype == 'rodrigues': - o = damask.Orientation(Rodrigues= np.array(map(float,table.data[column:column+3])), + o = damask.Orientation(Rodrigues= np.array(list(map(float,table.data[column:column+3]))), symmetry = options.symmetry).reduced() elif inputtype == 'matrix': - o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose(), + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose(), symmetry = options.symmetry).reduced() elif inputtype == 'frame': - o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \ - table.data[column[1]:column[1]+3] + \ - table.data[column[2]:column[2]+3])).reshape(3,3), + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \ + table.data[column[1]:column[1]+3] + \ + table.data[column[2]:column[2]+3]))).reshape(3,3), symmetry = options.symmetry).reduced() elif inputtype == 'quaternion': - o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4])), + o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))), symmetry = options.symmetry).reduced() o.quaternion = r*o.quaternion*R # apply additional lab and crystal frame rotations diff --git a/processing/post/addPK2.py b/processing/post/addPK2.py index 9e6308c39..82898efde 100755 --- a/processing/post/addPK2.py +++ b/processing/post/addPK2.py @@ -75,8 +75,8 @@ for name in filenames: # ------------------------------------------ process data ------------------------------------------ outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - F = np.array(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9]),'d').reshape(3,3) - P = np.array(map(float,table.data[column[options.stress ]:column[options.stress ]+9]),'d').reshape(3,3) + F = np.array(list(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9])),'d').reshape(3,3) + P = np.array(list(map(float,table.data[column[options.stress ]:column[options.stress ]+9])),'d').reshape(3,3) table.data_append(list(np.dot(np.linalg.inv(F),P).reshape(9))) # [S] =[P].[F-1] outputAlive = table.data_write() # output processed line diff --git a/processing/post/addSchmidfactors.py b/processing/post/addSchmidfactors.py index 4f34621b7..81f240ac1 100755 --- a/processing/post/addSchmidfactors.py +++ b/processing/post/addSchmidfactors.py @@ -252,15 +252,15 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table if inputtype == 'eulers': - o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians,) + o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians,) elif inputtype == 'matrix': - o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose(),) + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose(),) elif inputtype == 'frame': - o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \ - table.data[column[1]:column[1]+3] + \ - table.data[column[2]:column[2]+3])).reshape(3,3),) + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \ + table.data[column[1]:column[1]+3] + \ + table.data[column[2]:column[2]+3]))).reshape(3,3),) elif inputtype == 'quaternion': - o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4])),) + o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))),) rotForce = o.quaternion.conjugated() * force rotNormal = o.quaternion.conjugated() * normal diff --git a/processing/post/addSpectralDecomposition.py b/processing/post/addSpectralDecomposition.py index b21900c0c..6eea8bee2 100755 --- a/processing/post/addSpectralDecomposition.py +++ b/processing/post/addSpectralDecomposition.py @@ -86,7 +86,7 @@ for name in filenames: while outputAlive and table.data_read(): # read next data line of ASCII table for type, data in items.items(): for column in data['column']: - (u,v) = np.linalg.eigh(np.array(map(float,table.data[column:column+data['dim']])).reshape(data['shape'])) + (u,v) = np.linalg.eigh(np.array(list(map(float,table.data[column:column+data['dim']]))).reshape(data['shape'])) if options.rh and np.dot(np.cross(v[:,0], v[:,1]), v[:,2]) < 0.0 : v[:, 2] *= -1.0 # ensure right-handed eigenvector basis table.data_append(list(u)) # vector of max,mid,min eigval table.data_append(list(v.transpose().reshape(data['dim']))) # 3x3=9 combo vector of max,mid,min eigvec coordinates diff --git a/processing/post/addStrainTensors.py b/processing/post/addStrainTensors.py index 7cb9f3079..14d66d5f6 100755 --- a/processing/post/addStrainTensors.py +++ b/processing/post/addStrainTensors.py @@ -132,7 +132,7 @@ for name in filenames: while outputAlive and table.data_read(): # read next data line of ASCII table for column in items['tensor']['column']: # loop over all requested defgrads - F = np.array(map(float,table.data[column:column+items['tensor']['dim']]),'d').reshape(items['tensor']['shape']) + F = np.array(list(map(float,table.data[column:column+items['tensor']['dim']])),'d').reshape(items['tensor']['shape']) (U,S,Vh) = np.linalg.svd(F) # singular value decomposition R = np.dot(U,Vh) # rotation of polar decomposition stretch['U'] = np.dot(np.linalg.inv(R),F) # F = RU diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index c5e4882b9..ce8156038 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -100,13 +100,13 @@ for name in filenames: for column in items[datatype]['column']: # loop over all requested labels table.data[column:column+items[datatype]['dim']] = \ - q * np.array(map(float,table.data[column:column+items[datatype]['dim']])) + q * np.array(list(map(float,table.data[column:column+items[datatype]['dim']]))) datatype = 'tensor' for column in items[datatype]['column']: # loop over all requested labels table.data[column:column+items[datatype]['dim']] = \ - np.dot(R,np.dot(np.array(map(float,table.data[column:column+items[datatype]['dim']])).\ + np.dot(R,np.dot(np.array(list(map(float,table.data[column:column+items[datatype]['dim']]))).\ reshape(items[datatype]['shape']),R.transpose())).reshape(items[datatype]['dim']) outputAlive = table.data_write() # output processed line diff --git a/processing/post/vtk2ang.py b/processing/post/vtk2ang.py index 6da07bc02..123dc5b98 100755 --- a/processing/post/vtk2ang.py +++ b/processing/post/vtk2ang.py @@ -421,8 +421,6 @@ for filename in filenames: meshActor.GetProperty().SetOpacity(0.2) meshActor.GetProperty().SetColor(1.0,1.0,0) meshActor.GetProperty().BackfaceCullingOn() - # meshActor.GetProperty().SetEdgeColor(1,1,0.5) - # meshActor.GetProperty().EdgeVisibilityOn() boxpoints = vtk.vtkPoints() for n in range(8): diff --git a/processing/post/vtk_rectilinearGrid.py b/processing/post/vtk_rectilinearGrid.py index 326f26046..d01d118cb 100755 --- a/processing/post/vtk_rectilinearGrid.py +++ b/processing/post/vtk_rectilinearGrid.py @@ -82,7 +82,7 @@ for name in filenames: [coords[i][j-1] + coords[i][j] for j in range(1,len(coords[i]))] + \ [3.0 * coords[i][-1] - coords[i][-1 - int(len(coords[i]) > 1)]]) for i in range(3)] - grid = np.array(map(len,coords),'i') + grid = np.array(list(map(len,coords)),'i') N = grid.prod() if options.mode == 'point' else (grid-1).prod() if N != len(table.data): From 1384fdead1fb139c16d1a91743a5ed68a8569359 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 19 Jul 2018 23:56:47 +0200 Subject: [PATCH 065/208] [skip ci] updated version information after successful test of v2.0.2-241-g800f86e4 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 1779757ff..8f6be5bd3 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-232-gef6ffc94 +v2.0.2-241-g800f86e4 From 784ae28dbb6265b10ac4a84d922d2084c9f68125 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 20 Jul 2018 00:39:50 +0200 Subject: [PATCH 066/208] now working with python 3 --- processing/pre/geom_fromOsteonGeometry.py | 12 ++++-------- processing/pre/geom_fromTable.py | 8 ++++---- processing/pre/geom_fromVoronoiTessellation.py | 3 +-- 3 files changed, 9 insertions(+), 14 deletions(-) diff --git a/processing/pre/geom_fromOsteonGeometry.py b/processing/pre/geom_fromOsteonGeometry.py index 716a43615..807e5200e 100755 --- a/processing/pre/geom_fromOsteonGeometry.py +++ b/processing/pre/geom_fromOsteonGeometry.py @@ -55,9 +55,9 @@ parser.set_defaults(canal = 25e-6, (options,filename) = parser.parse_args() -if np.any(options.grid < 2): +if np.any(np.array(options.grid) < 2): parser('invalid grid a b c.') -if np.any(options.size <= 0.0): +if np.any(np.array(options.size) <= 0.0): parser('invalid size x y z.') # --- open input files ---------------------------------------------------------------------------- @@ -114,12 +114,8 @@ for y in range(info['grid'][1]): info['microstructures'] += 1 #--- report --------------------------------------------------------------------------------------- -damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), - 'size x y z: %s'%(' x '.join(map(str,info['size']))), - 'origin x y z: %s'%(' : '.join(map(str,info['origin']))), - 'homogenization: %i'%info['homogenization'], - 'microstructures: %i'%info['microstructures']]) -# -------------------------------------- switch according to task ---------------------------------- +damask.util.report_geom(info,['grid','size','origin','homogenization','microstructures']) + formatwidth = 1+int(math.floor(math.log10(info['microstructures']-1))) header = [scriptID + ' ' + ' '.join(sys.argv[1:])] header.append('') diff --git a/processing/pre/geom_fromTable.py b/processing/pre/geom_fromTable.py index b10bc9f88..6cdf4b76e 100755 --- a/processing/pre/geom_fromTable.py +++ b/processing/pre/geom_fromTable.py @@ -152,7 +152,7 @@ for name in filenames: continue table.data_readArray([options.pos] \ - + ([label] if isinstance(label, types.StringTypes) else label) \ + + (label if isinstance(label, list) else [label]) \ + ([options.phase] if options.phase else [])) if coordDim == 2: @@ -165,9 +165,9 @@ for name in filenames: # --------------- figure out size and grid --------------------------------------------------------- coords = [np.unique(table.data[:,i]) for i in range(3)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') + mincorner = np.array(list(map(min,coords))) + maxcorner = np.array(list(map(max,coords))) + grid = np.array(list(map(len,coords)),'i') size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings delta = size/np.maximum(np.ones(3,'d'), grid) diff --git a/processing/pre/geom_fromVoronoiTessellation.py b/processing/pre/geom_fromVoronoiTessellation.py index 4dcb5b40f..f57f1d35e 100755 --- a/processing/pre/geom_fromVoronoiTessellation.py +++ b/processing/pre/geom_fromVoronoiTessellation.py @@ -15,8 +15,7 @@ scriptID = ' '.join([scriptName,damask.version]) def meshgrid2(*arrs): """Code inspired by http://stackoverflow.com/questions/1827489/numpy-meshgrid-in-3d""" arrs = tuple(reversed(arrs)) - arrs = tuple(arrs) - lens = np.array(map(len, arrs)) + lens = np.array(list(map(len, arrs))) dim = len(arrs) ans = [] for i, arr in enumerate(arrs): From 2632be2a7634b87ddecd29a1eb4ddaa6588ce812 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 20 Jul 2018 03:09:53 +0200 Subject: [PATCH 067/208] polishing --- lib/damask/util.py | 6 ++++-- processing/post/addCurl.py | 1 - 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/lib/damask/util.py b/lib/damask/util.py index 93387205e..8727a1473 100644 --- a/lib/damask/util.py +++ b/lib/damask/util.py @@ -93,8 +93,10 @@ def execute(cmd, stdout = subprocess.PIPE, stderr = subprocess.PIPE, stdin = subprocess.PIPE) - out,error = [i.replace(b"\x08",b"") for i in (process.communicate() if streamIn is None - else process.communicate(streamIn.read()))] + out,error = [i for i in (process.communicate() if streamIn is None + else process.communicate(streamIn.read().encode('utf-8')))] + out = out.decode('utf-8').replace('\x08','') + error = error.decode('utf-8').replace('\x08','') os.chdir(initialPath) if process.returncode != 0: raise RuntimeError('{} failed with returncode {}'.format(cmd,process.returncode)) return out,error diff --git a/processing/post/addCurl.py b/processing/post/addCurl.py index 5ca851b22..52a4ae438 100755 --- a/processing/post/addCurl.py +++ b/processing/post/addCurl.py @@ -138,7 +138,6 @@ for name in filenames: # --------------- figure out size and grid --------------------------------------------------------- table.data_readArray() - grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) # ------------------------------------------ process value field ----------------------------------- From b59145fca5761b627e086eb642ed9c78ba4fe3fa Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 20 Jul 2018 03:11:10 +0200 Subject: [PATCH 068/208] also using python 3 compatible tests --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 0c9db9b75..4cbe7024b 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 0c9db9b7542e7e1c3cac96e4821be9d9a7505a9d +Subproject commit 4cbe7024b4ebd1ef3ee35fbf8b9676f1c377f462 From 24d1528e04c77d3a22e50a7a76314978f2f5e3dc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 20 Jul 2018 03:31:46 +0200 Subject: [PATCH 069/208] on the way to full python 3 compatibility --- PRIVATE | 2 +- processing/pre/hybridIA_linODFsampling.py | 2 +- processing/pre/mentat_spectralBox.py | 13 ++++++++++--- 3 files changed, 12 insertions(+), 5 deletions(-) diff --git a/PRIVATE b/PRIVATE index 4cbe7024b..12ecac5ad 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 4cbe7024b4ebd1ef3ee35fbf8b9676f1c377f462 +Subproject commit 12ecac5ad75a160d5ee8e2b18b752fdab11dfa0d diff --git a/processing/pre/hybridIA_linODFsampling.py b/processing/pre/hybridIA_linODFsampling.py index e4735674a..d1b0efd57 100755 --- a/processing/pre/hybridIA_linODFsampling.py +++ b/processing/pre/hybridIA_linODFsampling.py @@ -270,7 +270,7 @@ for name in filenames: ODF['limit'] = np.radians(limits[1,:]) # right hand limits in radians ODF['center'] = 0.0 if all(limits[0,:]<1e-8) else 0.5 # vertex or cell centered - ODF['interval'] = np.array(map(len,[np.unique(table.data[:,i]) for i in range(3)]),'i') # steps are number of distict values + ODF['interval'] = np.array(list(map(len,[np.unique(table.data[:,i]) for i in range(3)])),'i') # steps are number of distict values ODF['nBins'] = ODF['interval'].prod() ODF['delta'] = np.radians(np.array(limits[1,0:3]-limits[0,0:3])/(ODF['interval']-1)) # step size diff --git a/processing/pre/mentat_spectralBox.py b/processing/pre/mentat_spectralBox.py index 16c982f82..0299b35dc 100755 --- a/processing/pre/mentat_spectralBox.py +++ b/processing/pre/mentat_spectralBox.py @@ -77,7 +77,14 @@ def mesh(r,d): "%f %f %f"%(-d[0],d[1],d[2]), "%f %f %f"%(-d[0],d[1],0.0), "*add_elements", - range(1,9), + "1", + "2", + "3", + "4", + "5", + "6", + "7", + "8", "*sub_divisions", "%i %i %i"%(r[2],r[1],r[0]), "*subdivide_elements", @@ -201,7 +208,7 @@ if options.port: except: parser.error('no valid Mentat release found.') -# --- loop over input files ------------------------------------------------------------------------- +# --- loop over input files ------------------------------------------------------------------------ if filenames == []: filenames = [None] @@ -236,7 +243,7 @@ for name in filenames: # --- read data ------------------------------------------------------------------------------------ - microstructure = table.microstructure_read(info['grid']).reshape(info['grid'].prod(),order='F') # read microstructure + microstructure = table.microstructure_read(info['grid']).reshape(info['grid'].prod(),order='F') # read microstructure cmds = [\ init(), From 0c67f28178450fd7dad741d5bea2577b3f29ce93 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 20 Jul 2018 03:46:00 +0200 Subject: [PATCH 070/208] python3 compatible tests --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 12ecac5ad..55609e107 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 12ecac5ad75a160d5ee8e2b18b752fdab11dfa0d +Subproject commit 55609e1079d6ffde6dffdd584ee22a527ff00a34 From 8616a923096d37640c9fda1e791268ad8d28c735 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 20 Jul 2018 03:50:07 +0200 Subject: [PATCH 071/208] unused module --- processing/pre/geom_fromTable.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/processing/pre/geom_fromTable.py b/processing/pre/geom_fromTable.py index 6cdf4b76e..33b75b307 100755 --- a/processing/pre/geom_fromTable.py +++ b/processing/pre/geom_fromTable.py @@ -1,7 +1,7 @@ #!/usr/bin/env python2.7 # -*- coding: UTF-8 no BOM -*- -import os,sys,math,types,time +import os,sys,math,time import scipy.spatial, numpy as np from optparse import OptionParser import damask From 2d1e933c3d3b2e0946620ad1ee3c723cfd99a7f3 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 20 Jul 2018 11:03:47 +0200 Subject: [PATCH 072/208] [skip ci] updated version information after successful test of v2.0.2-250-g8616a923 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 8f6be5bd3..0acf5a908 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-241-g800f86e4 +v2.0.2-250-g8616a923 From e7fd445816807e870aa3affbdb1cfd1f82b97f65 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 20 Jul 2018 14:13:13 +0200 Subject: [PATCH 073/208] WIP: Simplifying using maxval gives inherently correct values and a consistency check is not needed any more using config_phase capabilities to read in lattice related data --- src/lattice.f90 | 468 +++++++++++++++++++----------------------------- 1 file changed, 180 insertions(+), 288 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 386001c76..3064c363e 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -88,11 +88,11 @@ module lattice LATTICE_fcc_NcleavageSystem = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc integer(pInt), parameter, private :: & - LATTICE_fcc_Nslip = 12_pInt, & !sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc - LATTICE_fcc_Ntwin = 12_pInt, & !sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc + LATTICE_fcc_Nslip = sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc + LATTICE_fcc_Ntwin = sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc LATTICE_fcc_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for fcc - LATTICE_fcc_Ntrans = 12_pInt, & !sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc - LATTICE_fcc_Ncleavage = 7_pInt !sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc + LATTICE_fcc_Ntrans = sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc + LATTICE_fcc_Ncleavage = sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc real(pReal), dimension(3+3,LATTICE_fcc_Nslip), parameter, private :: & LATTICE_fcc_systemSlip = reshape(real([& @@ -371,11 +371,11 @@ module lattice LATTICE_bcc_NcleavageSystem = int([3,6,0],pInt) !< # of cleavage systems per family for bcc integer(pInt), parameter, private :: & - LATTICE_bcc_Nslip = 24_pInt, & !sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc - LATTICE_bcc_Ntwin = 12_pInt, & !sum(lattice_bcc_NtwinSystem), & !< total # of twin systems for bcc + LATTICE_bcc_Nslip = sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc + LATTICE_bcc_Ntwin = sum(lattice_bcc_NtwinSystem), & !< total # of twin systems for bcc LATTICE_bcc_NnonSchmid = 6_pInt, & !< total # of non-Schmid contributions for bcc (A. Koester, A. Ma, A. Hartmaier 2012) - LATTICE_bcc_Ntrans = 0_pInt, & !sum(lattice_bcc_NtransSystem), & !< total # of transformation systems for bcc - LATTICE_bcc_Ncleavage = 9_pInt !sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc + LATTICE_bcc_Ntrans = sum(lattice_bcc_NtransSystem), & !< total # of transformation systems for bcc + LATTICE_bcc_Ncleavage = sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc real(pReal), dimension(3+3,LATTICE_bcc_Nslip), parameter, private :: & LATTICE_bcc_systemSlip = reshape(real([& @@ -556,7 +556,7 @@ module lattice !-------------------------------------------------------------------------------------------------- ! hexagonal integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - lattice_hex_NslipSystem = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex + lattice_hex_NslipSystem = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & lattice_hex_NtwinSystem = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex @@ -568,11 +568,11 @@ module lattice LATTICE_hex_NcleavageSystem = int([3,0,0],pInt) !< # of cleavage systems per family for hex integer(pInt), parameter, private :: & - LATTICE_hex_Nslip = 33_pInt, & !sum(lattice_hex_NslipSystem), & !< total # of slip systems for hex - LATTICE_hex_Ntwin = 24_pInt, & !sum(lattice_hex_NtwinSystem), & !< total # of twin systems for hex + LATTICE_hex_Nslip = sum(lattice_hex_NslipSystem), & !< total # of slip systems for hex + LATTICE_hex_Ntwin = sum(lattice_hex_NtwinSystem), & !< total # of twin systems for hex LATTICE_hex_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for hex - LATTICE_hex_Ntrans = 0_pInt, & !sum(lattice_hex_NtransSystem), & !< total # of transformation systems for hex - LATTICE_hex_Ncleavage = 3_pInt !sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex + LATTICE_hex_Ntrans = sum(lattice_hex_NtransSystem), & !< total # of transformation systems for hex + LATTICE_hex_Ncleavage = sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex real(pReal), dimension(4+4,LATTICE_hex_Nslip), parameter, private :: & LATTICE_hex_systemSlip = reshape(real([& @@ -850,11 +850,11 @@ module lattice LATTICE_bct_NcleavageSystem = int([0,0,0],pInt) !< # of cleavage systems per family for bct integer(pInt), parameter, private :: & - LATTICE_bct_Nslip = 52_pInt, & !sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct - LATTICE_bct_Ntwin = 0_pInt, & !sum(lattice_bct_NtwinSystem), & !< total # of twin systems for bct + LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct + LATTICE_bct_Ntwin = sum(lattice_bct_NtwinSystem), & !< total # of twin systems for bct LATTICE_bct_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for bct - LATTICE_bct_Ntrans = 0_pInt, & !sum(lattice_bct_NtransSystem), & !< total # of transformation systems for bct - LATTICE_bct_Ncleavage = 0_pInt !sum(lattice_bct_NcleavageSystem) !< total # of cleavage systems for bct + LATTICE_bct_Ntrans = sum(lattice_bct_NtransSystem), & !< total # of transformation systems for bct + LATTICE_bct_Ncleavage = sum(lattice_bct_NcleavageSystem) !< total # of cleavage systems for bct real(pReal), dimension(3+3,LATTICE_bct_Nslip), parameter, private :: & LATTICE_bct_systemSlip = reshape(real([& @@ -1039,11 +1039,11 @@ module lattice LATTICE_ortho_NcleavageSystem = int([1,1,1],pInt) !< # of cleavage systems per family for ortho integer(pInt), parameter, private :: & - LATTICE_ortho_Nslip = 0_pInt, & !sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho - LATTICE_ortho_Ntwin = 0_pInt, & !sum(lattice_ortho_NtwinSystem), & !< total # of twin systems for ortho + LATTICE_ortho_Nslip = sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho + LATTICE_ortho_Ntwin = sum(lattice_ortho_NtwinSystem), & !< total # of twin systems for ortho LATTICE_ortho_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for ortho - LATTICE_ortho_Ntrans = 0_pInt, & !sum(lattice_ortho_NtransSystem), & !< total # of transformation systems for ortho - LATTICE_ortho_Ncleavage = 3_pInt !sum(lattice_ortho_NcleavageSystem) !< total # of cleavage systems for ortho + LATTICE_ortho_Ntrans = sum(lattice_ortho_NtransSystem), & !< total # of transformation systems for ortho + LATTICE_ortho_Ncleavage = sum(lattice_ortho_NcleavageSystem) !< total # of cleavage systems for ortho real(pReal), dimension(3+3,LATTICE_ortho_Ncleavage), parameter, private :: & LATTICE_ortho_systemCleavage = reshape(real([& @@ -1054,23 +1054,18 @@ module lattice ],pReal),[ 3_pInt + 3_pInt,LATTICE_ortho_Ncleavage]) integer(pInt), parameter, public :: & - LATTICE_maxNslip = 52_pInt, & - !LATTICE_maxNslip = maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip,\ - ! LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures - LATTICE_maxNtwin = 24_pInt, & - !LATTICE_maxNtwin = maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin,\ - ! LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures - LATTICE_maxNnonSchmid = 6_pInt, & - !LATTICE_maxNtwin = maxval([LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid,\ - ! LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid,\ - ! LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures - LATTICE_maxNtrans = 12_pInt, & - !LATTICE_maxNtrans = maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans,\ - ! LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]),&!< max # of transformation systems over lattice structures - LATTICE_maxNcleavage = 9_pInt, & - !LATTICE_maxNcleavage = maxval([LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage,\ - ! LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage,\ - ! LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]) !< max # of cleavage systems over lattice structures + LATTICE_maxNslip = maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, & + LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures + LATTICE_maxNtwin = maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, & + LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures + LATTICE_maxNnonSchmid = maxval([LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & + LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & + LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures + LATTICE_maxNtrans = maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, & + LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]), & !< max # of transformation systems over lattice structures + LATTICE_maxNcleavage = maxval([LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & + LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, & + LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]) , & !< max # of cleavage systems over lattice structures LATTICE_maxNinteraction = 182_pInt !< max # of interaction types (in hardening matrix part) real(pReal), dimension(:,:,:), allocatable, public, protected :: & @@ -1250,36 +1245,20 @@ subroutine lattice_init compiler_options #endif use IO, only: & - IO_open_file,& - IO_open_jobFile_stat, & - IO_countSections, & IO_error, & - IO_timeStamp, & - IO_EOF, & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue + IO_timeStamp use config, only: & - material_configfile, & - material_localFileExt, & - material_partPhase + config_phase use debug, only: & debug_level, & debug_lattice, & debug_levelBasic implicit none - integer(pInt), parameter :: FILEUNIT = 200_pInt integer(pInt) :: Nphases character(len=65536) :: & - tag = '', & - line = '' - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: section = 0_pInt,i + tag = '' + integer(pInt) :: section = 0_pInt,i,p real(pReal), dimension(:), allocatable :: & CoverA, & !!!!!!< c/a ratio for low symmetry type lattice CoverA_trans, & !< c/a ratio for transformed hex type lattice @@ -1290,56 +1269,6 @@ subroutine lattice_init write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" -!-------------------------------------------------------------------------------------------------- -! consistency checks (required since ifort 15.0 does not support sum/maxval in parameter definition) - - if (LATTICE_maxNslip /= maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip,LATTICE_bct_Nslip])) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNslip') - if (LATTICE_maxNtwin /= maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin])) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNtwin') - if (LATTICE_maxNtrans /= maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans])) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNtrans') - if (LATTICE_maxNnonSchmid /= maxval([lattice_fcc_NnonSchmid,lattice_bcc_NnonSchmid,& - lattice_hex_NnonSchmid])) call IO_error(0_pInt,ext_msg = 'LATTICE_maxNnonSchmid') - - if (LATTICE_fcc_Nslip /= sum(lattice_fcc_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Nslip') - if (LATTICE_bcc_Nslip /= sum(lattice_bcc_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Nslip') - if (LATTICE_hex_Nslip /= sum(lattice_hex_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Nslip') - if (LATTICE_bct_Nslip /= sum(lattice_bct_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Nslip') - - if (LATTICE_fcc_Ntwin /= sum(lattice_fcc_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ntwin') - if (LATTICE_bcc_Ntwin /= sum(lattice_bcc_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ntwin') - if (LATTICE_hex_Ntwin /= sum(lattice_hex_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ntwin') - if (LATTICE_bct_Ntwin /= sum(lattice_bct_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ntwin') - - if (LATTICE_fcc_Ntrans /= sum(lattice_fcc_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ntrans') - if (LATTICE_bcc_Ntrans /= sum(lattice_bcc_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ntrans') - if (LATTICE_hex_Ntrans /= sum(lattice_hex_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ntrans') - if (LATTICE_bct_Ntrans /= sum(lattice_bct_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ntrans') - - if (LATTICE_fcc_Ncleavage /= sum(lattice_fcc_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ncleavage') - if (LATTICE_bcc_Ncleavage /= sum(lattice_bcc_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ncleavage') - if (LATTICE_hex_Ncleavage /= sum(lattice_hex_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ncleavage') - if (LATTICE_bct_Ncleavage /= sum(lattice_bct_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ncleavage') - if (LATTICE_iso_Ncleavage /= sum(lattice_iso_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_iso_Ncleavage') - if (LATTICE_maxNinteraction /= max(& maxval(lattice_fcc_interactionSlipSlip), & maxval(lattice_bcc_interactionSlipSlip), & @@ -1362,18 +1291,7 @@ subroutine lattice_init ! maxval(lattice_bct_interactionTwinTwin))) & call IO_error(0_pInt,ext_msg = 'LATTICE_maxNinteraction') -!-------------------------------------------------------------------------------------------------- -! read from material configuration file - if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... - call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file - Nphases = IO_countSections(FILEUNIT,material_partPhase) - - if(Nphases<1_pInt) & - call IO_error(160_pInt,Nphases, ext_msg='No phases found') - - if (iand(debug_level(debug_lattice),debug_levelBasic) /= 0_pInt) then - write(6,'(a16,1x,i5)') ' # phases:',Nphases - endif + Nphases = size(config_phase) allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID) allocate(trans_lattice_structure(Nphases),source = LATTICE_undefined_ID) @@ -1450,179 +1368,155 @@ subroutine lattice_init allocate(a_fcc(Nphases),source=0.0_pReal) allocate(a_bcc(Nphases),source=0.0_pReal) - rewind(fileUnit) - line = '' ! to have it initialized - section = 0_pInt ! - " - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - endif - if (section > 0_pInt) then - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('lattice_structure') - select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) + do section = 1, size(config_phase) + p = section + tag = config_phase(p)%getString('lattice_structure') + select case(trim(tag)) case('iso','isotropic') - lattice_structure(section) = LATTICE_iso_ID + lattice_structure(p) = LATTICE_iso_ID case('fcc') - lattice_structure(section) = LATTICE_fcc_ID + lattice_structure(p) = LATTICE_fcc_ID case('bcc') - lattice_structure(section) = LATTICE_bcc_ID + lattice_structure(p) = LATTICE_bcc_ID case('hex','hexagonal') - lattice_structure(section) = LATTICE_hex_ID + lattice_structure(p) = LATTICE_hex_ID case('bct') - lattice_structure(section) = LATTICE_bct_ID + lattice_structure(p) = LATTICE_bct_ID case('ort','orthorhombic') - lattice_structure(section) = LATTICE_ort_ID - case default - call IO_error(130_pInt,ext_msg=trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) - end select - case('trans_lattice_structure') - select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) - case('bcc') - trans_lattice_structure(section) = LATTICE_bcc_ID - case('hex','hexagonal','hcp') - trans_lattice_structure(section) = LATTICE_hex_ID - end select - case ('c11') - lattice_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c12') - lattice_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c13') - lattice_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c22') - lattice_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c23') - lattice_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c33') - lattice_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c44') - lattice_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c55') - lattice_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c66') - lattice_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c11_trans') - lattice_trans_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c12_trans') - lattice_trans_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c13_trans') - lattice_trans_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c22_trans') - lattice_trans_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c23_trans') - lattice_trans_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c33_trans') - lattice_trans_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c44_trans') - lattice_trans_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c55_trans') - lattice_trans_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c66_trans') - lattice_trans_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('covera_ratio','c/a_ratio','c/a') - CoverA(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c/a_trans','c/a_martensite','c/a_mart') - CoverA_trans(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('a_fcc') - a_fcc(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('a_bcc') - a_bcc(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_conductivity11') - lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_conductivity22') - lattice_thermalConductivity33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_conductivity33') - lattice_thermalConductivity33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_expansion11') - do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(1,1,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) - enddo - case ('thermal_expansion22') - do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(2,2,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) - enddo - case ('thermal_expansion33') - do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(3,3,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) - enddo - case ('specific_heat') - lattice_specificHeat(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyformationenergy') - lattice_vacancyFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancysurfaceenergy') - lattice_vacancySurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyvolume') - lattice_vacancyVol(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenformationenergy') - lattice_hydrogenFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogensurfaceenergy') - lattice_hydrogenSurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenvolume') - lattice_hydrogenVol(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('mass_density') - lattice_massDensity(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('reference_temperature') - lattice_referenceTemperature(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_diffusion11') - lattice_DamageDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_diffusion22') - lattice_DamageDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_diffusion33') - lattice_DamageDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_mobility') - lattice_DamageMobility(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_diffusion11') - lattice_vacancyfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_diffusion22') - lattice_vacancyfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_diffusion33') - lattice_vacancyfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_mobility11') - lattice_vacancyfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_mobility22') - lattice_vacancyfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_mobility33') - lattice_vacancyfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_diffusion11') - lattice_PorosityDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_diffusion22') - lattice_PorosityDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_diffusion33') - lattice_PorosityDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_mobility') - lattice_PorosityMobility(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_diffusion11') - lattice_hydrogenfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_diffusion22') - lattice_hydrogenfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_diffusion33') - lattice_hydrogenfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_mobility11') - lattice_hydrogenfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_mobility22') - lattice_hydrogenfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_mobility33') - lattice_hydrogenfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancy_eqcv') - lattice_equilibriumVacancyConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogen_eqch') - lattice_equilibriumHydrogenConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) - end select - endif - enddo + lattice_structure(p) = LATTICE_ort_ID +end select +! case('trans_lattice_structure') +! select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) +! case('bcc') +! trans_lattice_structure(section) = LATTICE_bcc_ID +! case('hex','hexagonal') +! trans_lattice_structure(section) = LATTICE_hex_ID +! end select + + + lattice_C66(1,1,section) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) + lattice_C66(1,2,section) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) + lattice_C66(1,3,section) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) + lattice_C66(2,3,section) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) + lattice_C66(3,3,section) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) + lattice_C66(4,4,section) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) + lattice_C66(5,5,section) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) + lattice_C66(6,6,section) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) + +! case ('c11_trans') +! lattice_trans_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c12_trans') +! lattice_trans_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c13_trans') +! lattice_trans_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c22_trans') +! lattice_trans_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c23_trans') +! lattice_trans_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c33_trans') +! lattice_trans_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c44_trans') +! lattice_trans_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c55_trans') +! lattice_trans_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c66_trans') +! lattice_trans_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) +! +! case ('covera_ratio','c/a_ratio','c/a') +! CoverA(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c/a_trans','c/a_martensite','c/a_mart') +! CoverA_trans(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('a_fcc') +! a_fcc(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('a_bcc') +! a_bcc(section) = IO_floatValue(line,chunkPos,2_pInt) +! +! case ('thermal_conductivity11') +! lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('thermal_conductivity22') +! lattice_thermalConductivity33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('thermal_conductivity33') +! lattice_thermalConductivity33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('thermal_expansion11') +! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) +! lattice_thermalExpansion33(1,1,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) +! enddo +! case ('thermal_expansion22') +! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) +! lattice_thermalExpansion33(2,2,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) +! enddo +! case ('thermal_expansion33') +! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) +! lattice_thermalExpansion33(3,3,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) +! enddo +! case ('specific_heat') +! lattice_specificHeat(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyformationenergy') +! lattice_vacancyFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancysurfaceenergy') +! lattice_vacancySurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyvolume') +! lattice_vacancyVol(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenformationenergy') +! lattice_hydrogenFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogensurfaceenergy') +! lattice_hydrogenSurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenvolume') +! lattice_hydrogenVol(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('mass_density') +! lattice_massDensity(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('reference_temperature') +! lattice_referenceTemperature(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('damage_diffusion11') +! lattice_DamageDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('damage_diffusion22') +! lattice_DamageDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('damage_diffusion33') +! lattice_DamageDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('damage_mobility') +! lattice_DamageMobility(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_diffusion11') +! lattice_vacancyfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_diffusion22') +! lattice_vacancyfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_diffusion33') +! lattice_vacancyfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_mobility11') +! lattice_vacancyfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_mobility22') +! lattice_vacancyfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_mobility33') +! lattice_vacancyfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('porosity_diffusion11') +! lattice_PorosityDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('porosity_diffusion22') +! lattice_PorosityDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('porosity_diffusion33') +! lattice_PorosityDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('porosity_mobility') +! lattice_PorosityMobility(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_diffusion11') +! lattice_hydrogenfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_diffusion22') +! lattice_hydrogenfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_diffusion33') +! lattice_hydrogenfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_mobility11') +! lattice_hydrogenfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_mobility22') +! lattice_hydrogenfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_mobility33') +! lattice_hydrogenfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancy_eqcv') +! lattice_equilibriumVacancyConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogen_eqch') +! lattice_equilibriumHydrogenConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) +! end select +! endif +! enddo + + enddo do i = 1_pInt,Nphases if ((CoverA(i) < 1.0_pReal .or. CoverA(i) > 2.0_pReal) & .and. lattice_structure(i) == LATTICE_hex_ID) call IO_error(131_pInt,el=i) ! checking physical significance of c/a @@ -1631,8 +1525,6 @@ subroutine lattice_init call lattice_initializeStructure(i, CoverA(i), CoverA_trans(i), a_fcc(i), a_bcc(i)) enddo - deallocate(CoverA,CoverA_trans,a_fcc,a_bcc) - end subroutine lattice_init From 76cf126566b9505e83a52453df5d6a85dbf1bacd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 20 Jul 2018 15:58:21 +0200 Subject: [PATCH 074/208] [skip sc] not really a patch but enables python (3) skipping syntax check as executable files normally only exist in processing and installation --- installation/patch/python2to3.sh | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100755 installation/patch/python2to3.sh diff --git a/installation/patch/python2to3.sh b/installation/patch/python2to3.sh new file mode 100755 index 000000000..1d86b0ce7 --- /dev/null +++ b/installation/patch/python2to3.sh @@ -0,0 +1,8 @@ +#! /usr/bin/env bash +if [ $1x != 3to2x ]; then + echo 'python2.7 to python' + find . -name '*.py' | xargs sed -i 's/usr\/bin\/env python2.7/usr\/bin\/env python/g' +else + echo 'python to python2.7' + find . -name '*.py' | xargs sed -i 's/usr\/bin\/env python/usr\/bin\/env python2.7/g' +fi From 5eff624d3f9ee978cba67c6e6063ea809488a0a2 Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 22 Jul 2018 06:39:27 +0200 Subject: [PATCH 075/208] [skip ci] updated version information after successful test of v2.0.2-253-gce203ca7 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 0acf5a908..d340e860c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-250-g8616a923 +v2.0.2-253-gce203ca7 From 449449b5007b31cb42fdaa02236f8157c36e2136 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 28 Jul 2018 01:31:02 +0200 Subject: [PATCH 076/208] does the same as numpy.clip --- src/math.f90 | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 39adcbba4..edf2ff5a6 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -160,7 +160,7 @@ module math math_rotate_forward33, & math_rotate_backward33, & math_rotate_forward3333, & - math_limit + math_clip private :: & math_check, & halton @@ -1363,16 +1363,16 @@ pure function math_RtoEuler(R) sqhk =sqrt(R(1,3)*R(1,3)+R(2,3)*R(2,3)) ! calculate PHI - math_RtoEuler(2) = acos(math_limit(R(3,3)/sqhkl,-1.0_pReal, 1.0_pReal)) + math_RtoEuler(2) = acos(math_clip(R(3,3)/sqhkl,-1.0_pReal, 1.0_pReal)) if((math_RtoEuler(2) < 1.0e-8_pReal) .or. (pi-math_RtoEuler(2) < 1.0e-8_pReal)) then math_RtoEuler(3) = 0.0_pReal - math_RtoEuler(1) = acos(math_limit(R(1,1)/squvw, -1.0_pReal, 1.0_pReal)) + math_RtoEuler(1) = acos(math_clip(R(1,1)/squvw, -1.0_pReal, 1.0_pReal)) if(R(2,1) > 0.0_pReal) math_RtoEuler(1) = 2.0_pReal*pi-math_RtoEuler(1) else - math_RtoEuler(3) = acos(math_limit(R(2,3)/sqhk, -1.0_pReal, 1.0_pReal)) + math_RtoEuler(3) = acos(math_clip(R(2,3)/sqhk, -1.0_pReal, 1.0_pReal)) if(R(1,3) < 0.0) math_RtoEuler(3) = 2.0_pReal*pi-math_RtoEuler(3) - math_RtoEuler(1) = acos(math_limit(-R(3,2)/sin(math_RtoEuler(2)), -1.0_pReal, 1.0_pReal)) + math_RtoEuler(1) = acos(math_clip(-R(3,2)/sin(math_RtoEuler(2)), -1.0_pReal, 1.0_pReal)) if(R(3,1) < 0.0) math_RtoEuler(1) = 2.0_pReal*pi-math_RtoEuler(1) end if @@ -1654,7 +1654,7 @@ pure function math_qToEuler(qPassive) math_qToEuler(2) = acos(1.0_pReal-2.0_pReal*(q(2)**2+q(3)**2)) if (abs(math_qToEuler(2)) < 1.0e-6_pReal) then - math_qToEuler(1) = sign(2.0_pReal*acos(math_limit(q(1),-1.0_pReal, 1.0_pReal)),q(4)) + math_qToEuler(1) = sign(2.0_pReal*acos(math_clip(q(1),-1.0_pReal, 1.0_pReal)),q(4)) math_qToEuler(3) = 0.0_pReal else math_qToEuler(1) = atan2(+q(1)*q(3)+q(2)*q(4), q(1)*q(2)-q(3)*q(4)) @@ -1681,7 +1681,7 @@ pure function math_qToAxisAngle(Q) real(pReal) :: halfAngle, sinHalfAngle real(pReal), dimension(4) :: math_qToAxisAngle - halfAngle = acos(math_limit(Q(1),-1.0_pReal,1.0_pReal)) + halfAngle = acos(math_clip(Q(1),-1.0_pReal,1.0_pReal)) sinHalfAngle = sin(halfAngle) smallRotation: if (sinHalfAngle <= 1.0e-4_pReal) then @@ -1741,7 +1741,7 @@ real(pReal) pure function math_EulerMisorientation(EulerA,EulerB) cosTheta = (math_trace33(math_mul33x33(math_EulerToR(EulerB), & transpose(math_EulerToR(EulerA)))) - 1.0_pReal) * 0.5_pReal - math_EulerMisorientation = acos(math_limit(cosTheta,-1.0_pReal,1.0_pReal)) + math_EulerMisorientation = acos(math_clip(cosTheta,-1.0_pReal,1.0_pReal)) end function math_EulerMisorientation @@ -2052,7 +2052,7 @@ function math_eigenvectorBasisSym33(m) EB(3,3,3)=1.0_pReal else threeSimilarEigenvalues rho=sqrt(-3.0_pReal*P**3.0_pReal)/9.0_pReal - phi=acos(math_limit(-Q/rho*0.5_pReal,-1.0_pReal,1.0_pReal)) + phi=acos(math_clip(-Q/rho*0.5_pReal,-1.0_pReal,1.0_pReal)) values = 2.0_pReal*rho**(1.0_pReal/3.0_pReal)* & [cos(phi/3.0_pReal), & cos((phi+2.0_pReal*PI)/3.0_pReal), & @@ -2117,7 +2117,7 @@ function math_eigenvectorBasisSym33_log(m) EB(3,3,3)=1.0_pReal else threeSimilarEigenvalues rho=sqrt(-3.0_pReal*P**3.0_pReal)/9.0_pReal - phi=acos(math_limit(-Q/rho*0.5_pReal,-1.0_pReal,1.0_pReal)) + phi=acos(math_clip(-Q/rho*0.5_pReal,-1.0_pReal,1.0_pReal)) values = 2.0_pReal*rho**(1.0_pReal/3.0_pReal)* & [cos(phi/3.0_pReal), & cos((phi+2.0_pReal*PI)/3.0_pReal), & @@ -2229,7 +2229,7 @@ function math_eigenvaluesSym33(m) math_eigenvaluesSym33 = math_eigenvaluesSym(m) else rho=sqrt(-3.0_pReal*P**3.0_pReal)/9.0_pReal - phi=acos(math_limit(-Q/rho*0.5_pReal,-1.0_pReal,1.0_pReal)) + phi=acos(math_clip(-Q/rho*0.5_pReal,-1.0_pReal,1.0_pReal)) math_eigenvaluesSym33 = 2.0_pReal*rho**(1.0_pReal/3.0_pReal)* & [cos(phi/3.0_pReal), & cos((phi+2.0_pReal*PI)/3.0_pReal), & @@ -2614,7 +2614,7 @@ end function math_rotate_forward3333 !> @brief limits a scalar value to a certain range (either one or two sided) ! Will return NaN if left > right !-------------------------------------------------------------------------------------------------- -real(pReal) pure function math_limit(a, left, right) +real(pReal) pure function math_clip(a, left, right) use, intrinsic :: & IEEE_arithmetic @@ -2623,14 +2623,14 @@ real(pReal) pure function math_limit(a, left, right) real(pReal), intent(in), optional :: left, right - math_limit = min ( & + math_clip = min ( & max (merge(left, -huge(a), present(left)), a), & merge(right, huge(a), present(right)) & ) if (present(left) .and. present(right)) & - math_limit = merge (IEEE_value(1.0_pReal,IEEE_quiet_NaN),math_limit, left>right) + math_clip = merge (IEEE_value(1.0_pReal,IEEE_quiet_NaN),math_clip, left>right) -end function math_limit +end function math_clip end module math From 708e2e0ac580ce75409185f8d679d9b31837f5ba Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 28 Jul 2018 16:16:31 +0200 Subject: [PATCH 077/208] [skip ci] updated version information after successful test of v2.0.2-255-g449449b5 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index d340e860c..75fa254a5 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-253-gce203ca7 +v2.0.2-255-g449449b5 From ed97afb51cf14dda17c4d3124fde1aa704fc3440 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 29 Jul 2018 21:03:14 +0200 Subject: [PATCH 078/208] WIP: inherent definition instead of check, using new reading in functionality --- PRIVATE | 2 +- src/lattice.f90 | 294 ++++++++++++++++++++---------------------------- 2 files changed, 121 insertions(+), 175 deletions(-) diff --git a/PRIVATE b/PRIVATE index 55609e107..20881ab8e 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 55609e1079d6ffde6dffdd584ee22a527ff00a34 +Subproject commit 20881ab8ebe6e64bac939ef6b2f8eb5168601a71 diff --git a/src/lattice.f90 b/src/lattice.f90 index 3064c363e..07f230358 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -16,7 +16,7 @@ module lattice integer(pInt), parameter, public :: & LATTICE_maxNslipFamily = 13_pInt, & !< max # of slip system families over lattice structures LATTICE_maxNtwinFamily = 4_pInt, & !< max # of twin system families over lattice structures - LATTICE_maxNtransFamily = 2_pInt, & !< max # of transformation system families over lattice structures + LATTICE_maxNtransFamily = 1_pInt, & !< max # of transformation system families over lattice structures LATTICE_maxNcleavageFamily = 3_pInt !< max # of transformation system families over lattice structures integer(pInt), allocatable, dimension(:,:), protected, public :: & @@ -82,7 +82,7 @@ module lattice LATTICE_fcc_NtwinSystem = int([12, 0, 0, 0],pInt) !< # of twin systems per family for fcc integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_fcc_NtransSystem = int([12, 0],pInt) !< # of transformation systems per family for fcc + LATTICE_fcc_NtransSystem = int([12],pInt) !< # of transformation systems per family for fcc integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & LATTICE_fcc_NcleavageSystem = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc @@ -365,10 +365,10 @@ module lattice LATTICE_bcc_NtwinSystem = int([ 12, 0, 0, 0], pInt) !< # of twin systems per family for bcc integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_bcc_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for bcc + LATTICE_bcc_NtransSystem = int([0],pInt) !< # of transformation systems per family for bcc integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_bcc_NcleavageSystem = int([3,6,0],pInt) !< # of cleavage systems per family for bcc + LATTICE_bcc_NcleavageSystem = int([3, 6, 0],pInt) !< # of cleavage systems per family for bcc integer(pInt), parameter, private :: & LATTICE_bcc_Nslip = sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc @@ -562,10 +562,10 @@ module lattice lattice_hex_NtwinSystem = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_hex_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for hex + LATTICE_hex_NtransSystem = int([0],pInt) !< # of transformation systems per family for hex integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_hex_NcleavageSystem = int([3,0,0],pInt) !< # of cleavage systems per family for hex + LATTICE_hex_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for hex integer(pInt), parameter, private :: & LATTICE_hex_Nslip = sum(lattice_hex_NslipSystem), & !< total # of slip systems for hex @@ -844,10 +844,10 @@ module lattice LATTICE_bct_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for bct integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_bct_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for bct + LATTICE_bct_NtransSystem = int([0],pInt) !< # of transformation systems per family for bct integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_bct_NcleavageSystem = int([0,0,0],pInt) !< # of cleavage systems per family for bct + LATTICE_bct_NcleavageSystem = int([0, 0, 0],pInt) !< # of cleavage systems per family for bct integer(pInt), parameter, private :: & LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct @@ -1004,17 +1004,17 @@ module lattice LATTICE_iso_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for iso integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_iso_NtransSystem = int([0, 0],pInt) !< # of transformation systems per family for iso + LATTICE_iso_NtransSystem = int([0],pInt) !< # of transformation systems per family for iso integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_iso_NcleavageSystem = int([3,0,0],pInt) !< # of cleavage systems per family for iso + LATTICE_iso_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for iso integer(pInt), parameter, private :: & - LATTICE_iso_Nslip = 0_pInt, & !sum(lattice_iso_NslipSystem), & !< total # of slip systems for iso - LATTICE_iso_Ntwin = 0_pInt, & !sum(lattice_iso_NtwinSystem), & !< total # of twin systems for iso + LATTICE_iso_Nslip = sum(lattice_iso_NslipSystem), & !< total # of slip systems for iso + LATTICE_iso_Ntwin = sum(lattice_iso_NtwinSystem), & !< total # of twin systems for iso LATTICE_iso_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for iso - LATTICE_iso_Ntrans = 0_pInt, & !sum(lattice_iso_NtransSystem), & !< total # of transformation systems for iso - LATTICE_iso_Ncleavage = 3_pInt !sum(lattice_iso_NcleavageSystem) !< total # of cleavage systems for iso + LATTICE_iso_Ntrans = sum(lattice_iso_NtransSystem), & !< total # of transformation systems for iso + LATTICE_iso_Ncleavage = sum(lattice_iso_NcleavageSystem) !< total # of cleavage systems for iso real(pReal), dimension(3+3,LATTICE_iso_Ncleavage), parameter, private :: & LATTICE_iso_systemCleavage = reshape(real([& @@ -1033,10 +1033,10 @@ module lattice LATTICE_ortho_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for ortho integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_ortho_NtransSystem = int([0, 0],pInt) !< # of transformation systems per family for ortho + LATTICE_ortho_NtransSystem = int([0],pInt) !< # of transformation systems per family for ortho integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_ortho_NcleavageSystem = int([1,1,1],pInt) !< # of cleavage systems per family for ortho + LATTICE_ortho_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho integer(pInt), parameter, private :: & LATTICE_ortho_Nslip = sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho @@ -1055,18 +1055,38 @@ module lattice integer(pInt), parameter, public :: & LATTICE_maxNslip = maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, & - LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures + LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures LATTICE_maxNtwin = maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, & - LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures + LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures LATTICE_maxNnonSchmid = maxval([LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & - LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures + LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures LATTICE_maxNtrans = maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, & - LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]), & !< max # of transformation systems over lattice structures + LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]), &!< max # of transformation systems over lattice structures LATTICE_maxNcleavage = maxval([LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, & - LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]) , & !< max # of cleavage systems over lattice structures - LATTICE_maxNinteraction = 182_pInt !< max # of interaction types (in hardening matrix part) + LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]), & !< max # of cleavage systems over lattice structures + LATTICE_maxNinteraction = maxval([ & + maxval(lattice_fcc_interactionSlipSlip), & + maxval(lattice_bcc_interactionSlipSlip), & + maxval(lattice_hex_interactionSlipSlip), & + maxval(lattice_bct_interactionSlipSlip), & + ! + maxval(lattice_fcc_interactionSlipTwin), & + maxval(lattice_bcc_interactionSlipTwin), & + maxval(lattice_hex_interactionSlipTwin), & + ! maxval(lattice_bct_interactionSlipTwin), & + ! + maxval(lattice_fcc_interactionTwinSlip), & + maxval(lattice_bcc_interactionTwinSlip), & + maxval(lattice_hex_interactionTwinSlip), & + ! maxval(lattice_bct_interactionTwinSlip), & + ! + maxval(lattice_fcc_interactionTwinTwin), & + maxval(lattice_bcc_interactionTwinTwin), & + maxval(lattice_hex_interactionTwinTwin) & + ! maxval(lattice_bct_interactionTwinTwin))) + ]) !< max # of interaction types (in hardening matrix part) real(pReal), dimension(:,:,:), allocatable, public, protected :: & lattice_C66, lattice_trans_C66 @@ -1249,10 +1269,6 @@ subroutine lattice_init IO_timeStamp use config, only: & config_phase - use debug, only: & - debug_level, & - debug_lattice, & - debug_levelBasic implicit none integer(pInt) :: Nphases @@ -1260,7 +1276,7 @@ subroutine lattice_init tag = '' integer(pInt) :: section = 0_pInt,i,p real(pReal), dimension(:), allocatable :: & - CoverA, & !!!!!!< c/a ratio for low symmetry type lattice + CoverA, & !< c/a ratio for low symmetry type lattice CoverA_trans, & !< c/a ratio for transformed hex type lattice a_fcc, & !< lattice parameter a for fcc austenite a_bcc !< lattice paramater a for bcc martensite @@ -1269,28 +1285,6 @@ subroutine lattice_init write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - if (LATTICE_maxNinteraction /= max(& - maxval(lattice_fcc_interactionSlipSlip), & - maxval(lattice_bcc_interactionSlipSlip), & - maxval(lattice_hex_interactionSlipSlip), & - maxval(lattice_bct_interactionSlipSlip), & - ! - maxval(lattice_fcc_interactionSlipTwin), & - maxval(lattice_bcc_interactionSlipTwin), & - maxval(lattice_hex_interactionSlipTwin), & -! maxval(lattice_bct_interactionSlipTwin), & - ! - maxval(lattice_fcc_interactionTwinSlip), & - maxval(lattice_bcc_interactionTwinSlip), & - maxval(lattice_hex_interactionTwinSlip), & -! maxval(lattice_bct_interactionTwinSlip), & - ! - maxval(lattice_fcc_interactionTwinTwin), & - maxval(lattice_bcc_interactionTwinTwin), & - maxval(lattice_hex_interactionTwinTwin))) & -! maxval(lattice_bct_interactionTwinTwin))) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNinteraction') - Nphases = size(config_phase) allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID) @@ -1368,23 +1362,22 @@ subroutine lattice_init allocate(a_fcc(Nphases),source=0.0_pReal) allocate(a_bcc(Nphases),source=0.0_pReal) - do section = 1, size(config_phase) - p = section - tag = config_phase(p)%getString('lattice_structure') - select case(trim(tag)) - case('iso','isotropic') - lattice_structure(p) = LATTICE_iso_ID - case('fcc') - lattice_structure(p) = LATTICE_fcc_ID - case('bcc') - lattice_structure(p) = LATTICE_bcc_ID - case('hex','hexagonal') - lattice_structure(p) = LATTICE_hex_ID - case('bct') - lattice_structure(p) = LATTICE_bct_ID - case('ort','orthorhombic') - lattice_structure(p) = LATTICE_ort_ID -end select + do p = 1, size(config_phase) + tag = config_phase(p)%getString('lattice_structure') + select case(trim(tag)) + case('iso','isotropic') + lattice_structure(p) = LATTICE_iso_ID + case('fcc') + lattice_structure(p) = LATTICE_fcc_ID + case('bcc') + lattice_structure(p) = LATTICE_bcc_ID + case('hex','hexagonal') + lattice_structure(p) = LATTICE_hex_ID + case('bct') + lattice_structure(p) = LATTICE_bct_ID + case('ort','orthorhombic') + lattice_structure(p) = LATTICE_ort_ID + end select ! case('trans_lattice_structure') ! select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) @@ -1394,44 +1387,30 @@ end select ! trans_lattice_structure(section) = LATTICE_hex_ID ! end select + lattice_C66(1,1,p) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) + lattice_C66(1,2,p) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) + lattice_C66(1,3,p) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) + lattice_C66(2,3,p) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) + lattice_C66(3,3,p) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) + lattice_C66(4,4,p) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) + lattice_C66(5,5,p) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) + lattice_C66(6,6,p) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) - lattice_C66(1,1,section) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) - lattice_C66(1,2,section) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) - lattice_C66(1,3,section) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) - lattice_C66(2,3,section) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) - lattice_C66(3,3,section) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) - lattice_C66(4,4,section) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) - lattice_C66(5,5,section) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) - lattice_C66(6,6,section) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) + lattice_trans_C66(1,1,p) = config_phase(p)%getFloat('c11_trans',defaultVal=0.0_pReal) + lattice_trans_C66(1,2,p) = config_phase(p)%getFloat('c12_trans',defaultVal=0.0_pReal) + lattice_trans_C66(1,3,p) = config_phase(p)%getFloat('c13_trans',defaultVal=0.0_pReal) + lattice_trans_C66(2,2,p) = config_phase(p)%getFloat('c22_trans',defaultVal=0.0_pReal) + lattice_trans_C66(2,3,p) = config_phase(p)%getFloat('c23_trans',defaultVal=0.0_pReal) + lattice_trans_C66(3,3,p) = config_phase(p)%getFloat('c33_trans',defaultVal=0.0_pReal) + lattice_trans_C66(4,4,p) = config_phase(p)%getFloat('c44_trans',defaultVal=0.0_pReal) + lattice_trans_C66(5,5,p) = config_phase(p)%getFloat('c55_trans',defaultVal=0.0_pReal) + lattice_trans_C66(6,6,p) = config_phase(p)%getFloat('c66_trans',defaultVal=0.0_pReal) + + CoverA(p) = config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal) + CoverA_trans(p) = config_phase(p)%getFloat('c/a_trans',defaultVal=0.0_pReal) + a_fcc(p) = config_phase(p)%getFloat('a_fcc',defaultVal=0.0_pReal) + a_bcc(p) = config_phase(p)%getFloat('a_bcc',defaultVal=0.0_pReal) -! case ('c11_trans') -! lattice_trans_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c12_trans') -! lattice_trans_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c13_trans') -! lattice_trans_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c22_trans') -! lattice_trans_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c23_trans') -! lattice_trans_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c33_trans') -! lattice_trans_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c44_trans') -! lattice_trans_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c55_trans') -! lattice_trans_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c66_trans') -! lattice_trans_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) -! -! case ('covera_ratio','c/a_ratio','c/a') -! CoverA(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c/a_trans','c/a_martensite','c/a_mart') -! CoverA_trans(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('a_fcc') -! a_fcc(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('a_bcc') -! a_bcc(section) = IO_floatValue(line,chunkPos,2_pInt) -! ! case ('thermal_conductivity11') ! lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) ! case ('thermal_conductivity22') @@ -1450,73 +1429,40 @@ end select ! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) ! lattice_thermalExpansion33(3,3,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) ! enddo -! case ('specific_heat') -! lattice_specificHeat(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyformationenergy') -! lattice_vacancyFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancysurfaceenergy') -! lattice_vacancySurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyvolume') -! lattice_vacancyVol(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenformationenergy') -! lattice_hydrogenFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogensurfaceenergy') -! lattice_hydrogenSurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenvolume') -! lattice_hydrogenVol(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('mass_density') -! lattice_massDensity(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('reference_temperature') -! lattice_referenceTemperature(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('damage_diffusion11') -! lattice_DamageDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('damage_diffusion22') -! lattice_DamageDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('damage_diffusion33') -! lattice_DamageDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('damage_mobility') -! lattice_DamageMobility(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_diffusion11') -! lattice_vacancyfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_diffusion22') -! lattice_vacancyfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_diffusion33') -! lattice_vacancyfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_mobility11') -! lattice_vacancyfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_mobility22') -! lattice_vacancyfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_mobility33') -! lattice_vacancyfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('porosity_diffusion11') -! lattice_PorosityDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('porosity_diffusion22') -! lattice_PorosityDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('porosity_diffusion33') -! lattice_PorosityDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('porosity_mobility') -! lattice_PorosityMobility(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_diffusion11') -! lattice_hydrogenfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_diffusion22') -! lattice_hydrogenfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_diffusion33') -! lattice_hydrogenfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_mobility11') -! lattice_hydrogenfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_mobility22') -! lattice_hydrogenfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_mobility33') -! lattice_hydrogenfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancy_eqcv') -! lattice_equilibriumVacancyConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogen_eqch') -! lattice_equilibriumHydrogenConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) -! end select -! endif -! enddo + lattice_specificHeat(p) = config_phase(p)%getFloat( 'specific_heat',defaultVal=0.0_pReal) + lattice_vacancyFormationEnergy(p) = config_phase(p)%getFloat( 'vacancyformationenergy',defaultVal=0.0_pReal) + lattice_vacancySurfaceEnergy(p) = config_phase(p)%getFloat( 'vacancyvolume',defaultVal=0.0_pReal) + lattice_vacancyVol(p) = config_phase(p)%getFloat( 'vacancysurfaceenergy',defaultVal=0.0_pReal) + lattice_hydrogenFormationEnergy(p) = config_phase(p)%getFloat( 'hydrogenformationenergy',defaultVal=0.0_pReal) + lattice_hydrogenSurfaceEnergy(p) = config_phase(p)%getFloat( 'hydrogensurfaceenergy',defaultVal=0.0_pReal) + lattice_hydrogenVol(p) = config_phase(p)%getFloat( 'hydrogenvolume',defaultVal=0.0_pReal) + lattice_massDensity(p) = config_phase(p)%getFloat( 'mass_density',defaultVal=0.0_pReal) + lattice_referenceTemperature(p) = config_phase(p)%getFloat( 'reference_temperature',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(1,1,p) = config_phase(p)%getFloat( 'damage_diffusion11',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(2,2,p) = config_phase(p)%getFloat( 'damage_diffusion22',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(3,3,p) = config_phase(p)%getFloat( 'damage_diffusion33',defaultVal=0.0_pReal) + lattice_DamageMobility(p) = config_phase(p)%getFloat( 'damage_mobility',defaultVal=0.0_pReal) + lattice_vacancyfluxDiffusion33(1,1,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion11',defaultVal=0.0_pReal) + lattice_vacancyfluxDiffusion33(2,2,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion22',defaultVal=0.0_pReal) + lattice_vacancyfluxDiffusion33(3,3,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion33',defaultVal=0.0_pReal) + lattice_vacancyfluxMobility33(1,1,p) = config_phase(p)%getFloat( 'vacancyflux_mobility11',defaultVal=0.0_pReal) + lattice_vacancyfluxMobility33(2,2,p) = config_phase(p)%getFloat( 'vacancyflux_mobility22',defaultVal=0.0_pReal) + lattice_vacancyfluxMobility33(3,3,p) = config_phase(p)%getFloat( 'vacancyflux_mobility33',defaultVal=0.0_pReal) + lattice_PorosityDiffusion33(1,1,p) = config_phase(p)%getFloat( 'porosity_diffusion11',defaultVal=0.0_pReal) + lattice_PorosityDiffusion33(2,2,p) = config_phase(p)%getFloat( 'porosity_diffusion22',defaultVal=0.0_pReal) + lattice_PorosityDiffusion33(3,3,p) = config_phase(p)%getFloat( 'porosity_diffusion33',defaultVal=0.0_pReal) + lattice_PorosityMobility(p) = config_phase(p)%getFloat( 'porosity_mobility',defaultVal=0.0_pReal) + lattice_hydrogenfluxDiffusion33(1,1,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion11',defaultVal=0.0_pReal) + lattice_hydrogenfluxDiffusion33(2,2,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion22',defaultVal=0.0_pReal) + lattice_hydrogenfluxDiffusion33(3,3,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion33',defaultVal=0.0_pReal) + lattice_hydrogenfluxMobility33(1,1,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility11',defaultVal=0.0_pReal) + lattice_hydrogenfluxMobility33(2,2,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility22',defaultVal=0.0_pReal) + lattice_hydrogenfluxMobility33(3,3,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility33',defaultVal=0.0_pReal) + lattice_equilibriumVacancyConcentration(p) = config_phase(p)%getFloat( 'vacancy_eqcv',defaultVal=0.0_pReal) + lattice_equilibriumHydrogenConcentration(p) = config_phase(p)%getFloat( 'hydrogen_eqch',defaultVal=0.0_pReal) enddo + do i = 1_pInt,Nphases if ((CoverA(i) < 1.0_pReal .or. CoverA(i) > 2.0_pReal) & .and. lattice_structure(i) == LATTICE_hex_ID) call IO_error(131_pInt,el=i) ! checking physical significance of c/a @@ -1682,16 +1628,16 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) myNtwin = lattice_fcc_Ntwin myNtrans = lattice_fcc_Ntrans myNcleavage = lattice_fcc_Ncleavage - do i = 1_pInt,myNslip ! assign slip system vectors + do i = 1_pInt,myNslip ! assign slip system vectors sd(1:3,i) = lattice_fcc_systemSlip(1:3,i) sn(1:3,i) = lattice_fcc_systemSlip(4:6,i) enddo - do i = 1_pInt,myNtwin ! assign twin system vectors and shears + do i = 1_pInt,myNtwin ! assign twin system vectors and shears td(1:3,i) = lattice_fcc_systemTwin(1:3,i) tn(1:3,i) = lattice_fcc_systemTwin(4:6,i) ts(i) = lattice_fcc_shearTwin(i) enddo - do i = 1_pInt, myNcleavage ! assign cleavage system vectors + do i = 1_pInt, myNcleavage ! assign cleavage system vectors cd(1:3,i) = lattice_fcc_systemCleavage(1:3,i)/norm2(lattice_fcc_systemCleavage(1:3,i)) cn(1:3,i) = lattice_fcc_systemCleavage(4:6,i)/norm2(lattice_fcc_systemCleavage(4:6,i)) ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) @@ -1699,16 +1645,16 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) ! Phase transformation select case(trans_lattice_structure(myPhase)) - case (LATTICE_bcc_ID) ! fcc to bcc transformation + case (LATTICE_bcc_ID) ! fcc to bcc transformation do i = 1_pInt,myNtrans - Rtr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation + Rtr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation lattice_fccTobcc_systemTrans(4,i)*INRAD) - Btr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system + Btr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system lattice_fccTobcc_bainRot(4,i)*INRAD) xtr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) ytr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) ztr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) - Utr(1:3,1:3,i) = 0.0_pReal ! Bain deformation + Utr(1:3,1:3,i) = 0.0_pReal ! Bain deformation if ((a_fcc > 0.0_pReal) .and. (a_bcc > 0.0_pReal)) then Utr(1:3,1:3,i) = (a_bcc/a_fcc)*math_tensorproduct33(xtr(1:3,i), xtr(1:3,i)) + & sqrt(2.0_pReal)*(a_bcc/a_fcc)*math_tensorproduct33(ytr(1:3,i), ytr(1:3,i)) + & From f9d8278ca66e33a04975db266914124d081eeb01 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 29 Jul 2018 22:41:18 +0200 Subject: [PATCH 079/208] using new test variant --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 55609e107..be1d25c20 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 55609e1079d6ffde6dffdd584ee22a527ff00a34 +Subproject commit be1d25c20233b148cb99cdedf202c685eb048ab1 From c96081c99a51817dd3b2a551ee6357ee9916505f Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 30 Jul 2018 11:36:05 +0200 Subject: [PATCH 080/208] [skip ci] updated version information after successful test of v2.0.2-257-gf9d8278c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 75fa254a5..f7f80b1c8 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-255-g449449b5 +v2.0.2-257-gf9d8278c From a908e663060c8cbb9544d491c543b3843606c695 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 30 Jul 2018 11:45:16 +0200 Subject: [PATCH 081/208] WIP: reading in new style --- src/homogenization.f90 | 1 - src/lattice.f90 | 25 ++++++++++++------------- src/numerics.f90 | 5 ----- 3 files changed, 12 insertions(+), 19 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 75330e86c..3565999a8 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -494,7 +494,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) subStepMinHomog, & subStepSizeHomog, & stepIncreaseHomog, & - nHomog, & nMPstate use math, only: & math_transpose33 diff --git a/src/lattice.f90 b/src/lattice.f90 index 07f230358..a0717659e 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1379,13 +1379,14 @@ subroutine lattice_init lattice_structure(p) = LATTICE_ort_ID end select -! case('trans_lattice_structure') -! select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) -! case('bcc') -! trans_lattice_structure(section) = LATTICE_bcc_ID -! case('hex','hexagonal') -! trans_lattice_structure(section) = LATTICE_hex_ID -! end select + tag = 'undefined' + tag = config_phase(p)%getString('trans_lattice_structure',defaultVal=tag) + select case(trim(tag)) + case('bcc') + trans_lattice_structure(section) = LATTICE_bcc_ID + case('hex','hexagonal') + trans_lattice_structure(section) = LATTICE_hex_ID + end select lattice_C66(1,1,p) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) lattice_C66(1,2,p) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) @@ -1411,12 +1412,10 @@ subroutine lattice_init a_fcc(p) = config_phase(p)%getFloat('a_fcc',defaultVal=0.0_pReal) a_bcc(p) = config_phase(p)%getFloat('a_bcc',defaultVal=0.0_pReal) -! case ('thermal_conductivity11') -! lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('thermal_conductivity22') -! lattice_thermalConductivity33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('thermal_conductivity33') -! lattice_thermalConductivity33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) + lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11') + lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22') + lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33') + ! case ('thermal_expansion11') ! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) ! lattice_thermalExpansion33(1,1,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) diff --git a/src/numerics.f90 b/src/numerics.f90 index 8de664248..56da2041e 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -16,7 +16,6 @@ module numerics integer(pInt), protected, public :: & iJacoStiffness = 1_pInt, & !< frequency of stiffness update iJacoLpresiduum = 1_pInt, & !< frequency of Jacobian update of residuum in Lp - nHomog = 20_pInt, & !< homogenization loop limit (only for debugging info, loop limit is determined by "subStepMinHomog") nMPstate = 10_pInt, & !< materialpoint state loop limit nCryst = 20_pInt, & !< crystallite loop limit (only for debugging info, loop limit is determined by "subStepMinCryst") nState = 10_pInt, & !< state loop limit @@ -284,8 +283,6 @@ subroutine numerics_init pert_Fg = IO_floatValue(line,chunkPos,2_pInt) case ('pert_method') pert_method = IO_intValue(line,chunkPos,2_pInt) - case ('nhomog') - nHomog = IO_intValue(line,chunkPos,2_pInt) case ('nmpstate') nMPstate = IO_intValue(line,chunkPos,2_pInt) case ('ncryst') @@ -536,7 +533,6 @@ subroutine numerics_init write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength - write(6,'(a24,1x,i8)') ' nHomog: ',nHomog write(6,'(a24,1x,es8.1)') ' subStepMinHomog: ',subStepMinHomog write(6,'(a24,1x,es8.1)') ' subStepSizeHomog: ',subStepSizeHomog write(6,'(a24,1x,es8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog @@ -646,7 +642,6 @@ subroutine numerics_init if (pert_Fg <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pert_Fg') if (pert_method <= 0_pInt .or. pert_method >= 4_pInt) & call IO_error(301_pInt,ext_msg='pert_method') - if (nHomog < 1_pInt) call IO_error(301_pInt,ext_msg='nHomog') if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate') if (nCryst < 1_pInt) call IO_error(301_pInt,ext_msg='nCryst') if (nState < 1_pInt) call IO_error(301_pInt,ext_msg='nState') From 06a0128d91b9b2a725b5a08c366e6b3bae549086 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 30 Jul 2018 12:40:31 +0200 Subject: [PATCH 082/208] no more aliases for c/a --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index be1d25c20..50eb21714 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit be1d25c20233b148cb99cdedf202c685eb048ab1 +Subproject commit 50eb21714e2f501b111bb62096ebb6a5bfc6708a From 2419deea8f43cc2b1aa2740ab9a1f1236a6dcbb1 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 30 Jul 2018 22:31:50 +0200 Subject: [PATCH 083/208] [skip ci] updated version information after successful test of v2.0.2-259-g06a0128d --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index f7f80b1c8..8bfea9185 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-257-gf9d8278c +v2.0.2-259-g06a0128d From bc3f6ae97c13cfcdd2f19cb084c9195e9b3be606 Mon Sep 17 00:00:00 2001 From: Pratheek Shanthraj Date: Tue, 31 Jul 2018 23:15:44 +0200 Subject: [PATCH 084/208] missing bits in getStrings function --- src/config.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/config.f90 b/src/config.f90 index 9d2ddde4c..d26b72c80 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -670,6 +670,7 @@ function getStrings(this,key,defaultVal,requiredShape,raw) endif else notAllocated if (whole) then + str = item%string%val(item%string%pos(4):) getStrings = [getStrings,str] else do i=2_pInt,item%string%pos(1) From e0a39d202c62cdd67f9b7c26eef4e2a6792bbfd1 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 1 Aug 2018 07:12:12 +0200 Subject: [PATCH 085/208] [skip ci] updated version information after successful test of v2.0.2-261-gbc3f6ae9 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 8bfea9185..fca0385fb 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-259-g06a0128d +v2.0.2-261-gbc3f6ae9 From 7283ee6caa42a980ecffe5db69161bbb3207dd68 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 1 Aug 2018 09:29:01 +0200 Subject: [PATCH 086/208] using updated tests from PRIVATE/master --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 14b60c558..a3e5f7a4b 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 14b60c558375731e80db8e5fa49cba753f0d0939 +Subproject commit a3e5f7a4ba42e841238af3cee1560a4429a39a6e From 5d09e98e02366417ceb57b9cdd6ca705e1b1a8f9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 01:14:18 +0200 Subject: [PATCH 087/208] checking with Philip --- src/plastic_phenopowerlaw.f90 | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index f854e7b00..f91ba28ae 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -591,7 +591,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) ! Calculation of the tangent of Lp - if (dNeq0(gdot_twin)) then !@ Philip: Needed? No division + if (dNeq0(gdot_twin)) then dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & @@ -606,6 +606,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, end associate end subroutine plastic_phenopowerlaw_LpAndItsTangent + !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- @@ -649,8 +650,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - associate( prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph)), dst => & -dotState(phase_plasticityInstance(ph))) + associate( prm => param(phase_plasticityInstance(ph)), & + stt => state(phase_plasticityInstance(ph)), & + dst => dotState(phase_plasticityInstance(ph))) dst%whole(:,of) = 0.0_pReal @@ -668,7 +670,7 @@ dotState(phase_plasticityInstance(ph))) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt - left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part + left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) **prm%a_slip & * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) @@ -707,7 +709,7 @@ dotState(phase_plasticityInstance(ph))) !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above do j = 1_pInt,prm%totalNslip - dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j + dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor enddo @@ -719,12 +721,12 @@ dotState(phase_plasticityInstance(ph))) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt - dst%s_twin(j,of) = & ! evolution of twin resistance j + dst%s_twin(j,of) = & ! evolution of twin resistance j c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (stt%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 dst%sumF(of) = dst%sumF(of) + gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) - dst%accshear_twin(j,of) = abs(gdot_twin(j)) + dst%accshear_twin(j,of) = abs(gdot_twin(j)) enddo twinSystems2 enddo twinFamilies2 end associate @@ -771,8 +773,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - associate( prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph)), dst => & -dotState(phase_plasticityInstance(ph))) + associate( prm => param(phase_plasticityInstance(ph)), & + stt => state(phase_plasticityInstance(ph)), & + dst => dotState(phase_plasticityInstance(ph))) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt @@ -828,13 +831,14 @@ dotState(phase_plasticityInstance(ph))) case (resistance_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & - stt%s_twin(1:prm%totalNtwin,of) + stt%s_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (accumulatedshear_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & stt%accshear_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin + case (shearrate_twin_ID) j = 0_pInt twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) From af931a78c7c779405ab213ac5610bebae58cf7f2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 08:09:28 +0200 Subject: [PATCH 088/208] finalizing reading in --- src/lattice.f90 | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index a0717659e..e5fde8be8 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1276,6 +1276,7 @@ subroutine lattice_init tag = '' integer(pInt) :: section = 0_pInt,i,p real(pReal), dimension(:), allocatable :: & + temp, & CoverA, & !< c/a ratio for low symmetry type lattice CoverA_trans, & !< c/a ratio for transformed hex type lattice a_fcc, & !< lattice parameter a for fcc austenite @@ -1416,18 +1417,12 @@ subroutine lattice_init lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22') lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33') -! case ('thermal_expansion11') -! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) -! lattice_thermalExpansion33(1,1,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) -! enddo -! case ('thermal_expansion22') -! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) -! lattice_thermalExpansion33(2,2,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) -! enddo -! case ('thermal_expansion33') -! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) -! lattice_thermalExpansion33(3,3,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) -! enddo + temp = config_phase(p)%getFloats('thermal_expansion11') ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(1,1,1:size(temp),p) = temp + temp = config_phase(p)%getFloats('thermal_expansion22') ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(2,2,1:size(temp),p) = temp + temp = config_phase(p)%getFloats('thermal_expansion33') ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(3,3,1:size(temp),p) = temp lattice_specificHeat(p) = config_phase(p)%getFloat( 'specific_heat',defaultVal=0.0_pReal) lattice_vacancyFormationEnergy(p) = config_phase(p)%getFloat( 'vacancyformationenergy',defaultVal=0.0_pReal) From c2f97095670a0f85538672cd683e52361e38adc4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 08:42:26 +0200 Subject: [PATCH 089/208] leaner, most of it also supported by older gcc --- src/lattice.f90 | 66 ++++++++++++++++++++++++++----------------------- 1 file changed, 35 insertions(+), 31 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index e5fde8be8..f75745433 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1054,40 +1054,44 @@ module lattice ],pReal),[ 3_pInt + 3_pInt,LATTICE_ortho_Ncleavage]) integer(pInt), parameter, public :: & - LATTICE_maxNslip = maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, & - LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures - LATTICE_maxNtwin = maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, & - LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures - LATTICE_maxNnonSchmid = maxval([LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & - LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & - LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures - LATTICE_maxNtrans = maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, & - LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]), &!< max # of transformation systems over lattice structures - LATTICE_maxNcleavage = maxval([LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & - LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, & - LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]), & !< max # of cleavage systems over lattice structures - LATTICE_maxNinteraction = maxval([ & - maxval(lattice_fcc_interactionSlipSlip), & - maxval(lattice_bcc_interactionSlipSlip), & - maxval(lattice_hex_interactionSlipSlip), & - maxval(lattice_bct_interactionSlipSlip), & + LATTICE_maxNslip = max(LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, & + LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip), & !< max # of slip systems over lattice structures + LATTICE_maxNtwin = max(LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, & + LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin), & !< max # of twin systems over lattice structures + LATTICE_maxNnonSchmid = max(LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & + LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & + LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid), & !< max # of non-Schmid contributions over lattice structures + LATTICE_maxNtrans = max(LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, & + LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans), & !< max # of transformation systems over lattice structures + LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & + LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, & + LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage), & !< max # of cleavage systems over lattice structures +#if defined(__GFORTRAN__) + ! only supported in gcc 8 + LATTICE_maxNinteraction = 182_pInt +#else + LATTICE_maxNinteraction = max(& + maxval(lattice_fcc_interactionSlipSlip), & + maxval(lattice_bcc_interactionSlipSlip), & + maxval(lattice_hex_interactionSlipSlip), & + maxval(lattice_bct_interactionSlipSlip), & ! - maxval(lattice_fcc_interactionSlipTwin), & - maxval(lattice_bcc_interactionSlipTwin), & - maxval(lattice_hex_interactionSlipTwin), & - ! maxval(lattice_bct_interactionSlipTwin), & + maxval(lattice_fcc_interactionSlipTwin), & + maxval(lattice_bcc_interactionSlipTwin), & + maxval(lattice_hex_interactionSlipTwin), & + !maxval(lattice_bct_interactionSlipTwin), & ! - maxval(lattice_fcc_interactionTwinSlip), & - maxval(lattice_bcc_interactionTwinSlip), & - maxval(lattice_hex_interactionTwinSlip), & - ! maxval(lattice_bct_interactionTwinSlip), & + maxval(lattice_fcc_interactionTwinSlip), & + maxval(lattice_bcc_interactionTwinSlip), & + maxval(lattice_hex_interactionTwinSlip), & + !maxval(lattice_bct_interactionTwinSlip), & ! - maxval(lattice_fcc_interactionTwinTwin), & - maxval(lattice_bcc_interactionTwinTwin), & - maxval(lattice_hex_interactionTwinTwin) & - ! maxval(lattice_bct_interactionTwinTwin))) - ]) !< max # of interaction types (in hardening matrix part) - + maxval(lattice_fcc_interactionTwinTwin), & + maxval(lattice_bcc_interactionTwinTwin), & + maxval(lattice_hex_interactionTwinTwin) & + !maxval(lattice_bct_interactionTwinTwin))) + ) !< max # of interaction types (in hardening matrix part) +#endif real(pReal), dimension(:,:,:), allocatable, public, protected :: & lattice_C66, lattice_trans_C66 real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & From dc6855261a438e25bbed6322c71d135a423de5d3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 08:53:37 +0200 Subject: [PATCH 090/208] number of helper functions for HDF5 --- src/CMakeLists.txt | 4 + src/HDF5_utilities.f90 | 1311 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 1315 insertions(+) create mode 100644 src/HDF5_utilities.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9418cd56d..be01bd4ee 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -31,6 +31,10 @@ add_library(IO OBJECT "IO.f90") add_dependencies(IO DAMASK_INTERFACE) list(APPEND OBJECTFILES $) +add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90") +add_dependencies(HDF5_UTILITIES IO) +list(APPEND OBJECTFILES $) + add_library(NUMERICS OBJECT "numerics.f90") add_dependencies(NUMERICS IO) list(APPEND OBJECTFILES $) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 new file mode 100644 index 000000000..bb09da7f7 --- /dev/null +++ b/src/HDF5_utilities.f90 @@ -0,0 +1,1311 @@ +module HDF5_Utilities + use prec + use IO + use HDF5 + use PETSC + + integer(HID_T), public, protected :: tempCoordinates, tempResults + integer(HID_T), private :: resultsFile, currentIncID, plist_id + integer(pInt), private :: currentInc + + public :: & + HDF5_Utilities_init, & + HDF5_mappingPhase, & + HDF5_mappingHomog, & + HDF5_mappingCrystallite, & + HDF5_backwardMappingPhase, & + HDF5_backwardMappingHomog, & + HDF5_backwardMappingCrystallite, & + HDF5_mappingCells, & + HDF5_addGroup ,& + HDF5_closeGroup ,& + HDF5_openGroup, & + HDF5_forwardResults, & + HDF5_writeVectorDataset, & + HDF5_writeScalarDataset, & + HDF5_writeTensorDataset, & + HDF5_closeJobFile, & + HDF5_removeLink +contains + +subroutine HDF5_Utilities_init + use, intrinsic :: & + iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + + implicit none + integer :: hdferr + integer(SIZE_T) :: typeSize + + write(6,'(/,a)') ' <<<+- HDF5_Utilities init -+>>>' +#include "compilation_info.f90" + + currentInc = -1_pInt + call HDF5_createJobFile + +end subroutine HDF5_Utilities_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates and initializes HDF5 output files +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_createJobFile + use hdf5 + use DAMASK_interface, only: & + getSolverWorkingDirectoryName, & + getSolverJobName + + implicit none + integer :: hdferr + integer(SIZE_T) :: typeSize + character(len=1024) :: path +#include + +!-------------------------------------------------------------------------------------------------- +! initialize HDF5 library and check if integer and float type size match + call h5open_f(hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5open_f') + call h5tget_size_f(H5T_NATIVE_INTEGER,typeSize, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5tget_size_f (int)') + if (int(pInt,SIZE_T)/=typeSize) call IO_error(0_pInt,ext_msg='pInt does not match H5T_NATIVE_INTEGER') + call h5tget_size_f(H5T_NATIVE_DOUBLE,typeSize, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5tget_size_f (double)') + if (int(pReal,SIZE_T)/=typeSize) call IO_error(0_pInt,ext_msg='pReal does not match H5T_NATIVE_DOUBLE') + + ! neu ab hier (4 zeilen) + call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5pcreate_f') + call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5pset_fapl_mpio_f') +!-------------------------------------------------------------------------------------------------- +! open file + path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//'hdf5' + !call h5fcreate_f(path,H5F_ACC_TRUNC_F,resultsFile,hdferr) + call h5fcreate_f(path,H5F_ACC_TRUNC_F,resultsFile,hdferr,access_prp = plist_id) + if (hdferr < 0) call IO_error(100_pInt,ext_msg=path) + call HDF5_addStringAttribute(resultsFile,'createdBy',DAMASKVERSION) + call h5pclose_f(plist_id, hdferr) !neu + +end subroutine HDF5_createJobFile + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates and initializes HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_closeJobFile() + use hdf5 + + implicit none + integer :: hdferr + call HDF5_removeLink('current') + call h5fclose_f(resultsFile,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_closeJobFile: h5fclose_f',el=hdferr) + CALL h5close_f(hdferr) + +end subroutine HDF5_closeJobFile + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a new group to the results file, or if loc is present at the given location +!-------------------------------------------------------------------------------------------------- +integer(HID_T) function HDF5_addGroup(path) + use hdf5 + + implicit none + character(len=*), intent(in) :: path + integer :: hdferr + + call h5gcreate_f(resultsFile, trim(path), HDF5_addGroup, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5gcreate_f ('//trim(path)//')') + +end function HDF5_addGroup + + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a new group to the results file +!-------------------------------------------------------------------------------------------------- +integer(HID_T) function HDF5_openGroup(path) + use hdf5 + + implicit none + character(len=*), intent(in) :: path + integer :: hdferr + + call h5gopen_f(resultsFile, trim(path), HDF5_openGroup, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5gopen_f ('//trim(path)//')') + +end function HDF5_openGroup + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a new group to the results file +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_setLink(path,link) + use hdf5 + + implicit none + character(len=*), intent(in) :: path, link + integer :: hdferr + logical :: linkExists + + call h5lexists_f(resultsFile, link,linkExists, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lexists_soft_f ('//trim(link)//')') + if (linkExists) then + call h5ldelete_f(resultsFile,link, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5ldelete_soft_f ('//trim(link)//')') + endif + call h5lcreate_soft_f(path, resultsFile, link, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lcreate_soft_f ('//trim(path)//' '//trim(link)//')') + +end subroutine HDF5_setLink + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a new group to the results file +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_removeLink(link) + use hdf5 + + implicit none + character(len=*), intent(in) :: link + integer :: hdferr + + call h5ldelete_f(resultsFile,link, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_removeLink: h5ldelete_soft_f ('//trim(link)//')') + +end subroutine HDF5_removeLink + + + +!-------------------------------------------------------------------------------------------------- +!> @brief closes a group +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_closeGroup(ID) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: ID + integer :: hdferr + + call h5gclose_f(ID, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = ID) + +end subroutine HDF5_closeGroup + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a new group to the results file +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addStringAttribute(entity,attrLabel,attrValue) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: entity + character(len=*), intent(in) :: attrLabel, attrValue + integer :: hdferr + integer(HID_T) :: attr_id, space_id, type_id + + call h5screate_f(H5S_SCALAR_F,space_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5screate_f') + call h5tcopy_f(H5T_NATIVE_CHARACTER, type_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5tcopy_f') + call h5tset_size_f(type_id, int(len(trim(attrValue)),HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5tset_size_f') + call h5acreate_f(entity, trim(attrLabel),type_id,space_id,attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5acreate_f') + call h5awrite_f(attr_id, type_id, trim(attrValue), int([1],HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5awrite_f') + call h5aclose_f(attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5aclose_f') + call h5sclose_f(space_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5sclose_f') + +end subroutine HDF5_addStringAttribute + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingPhase(mapping,mapping2,Nconstituents,material_phase,phase_name,dataspace_size,mpiOffset,mpiOffset_phase) + use hdf5 + + implicit none + integer(pInt), intent(in) :: Nconstituents, dataspace_size, mpiOffset + integer(pInt), intent(in), dimension(:) :: mapping, mapping2 + character(len=*), intent(in), dimension(:) :: phase_name + integer(pInt), intent(in), dimension(:) :: mpiOffset_phase + integer(pInt), intent(in), dimension(:,:,:) :: material_phase + + character(len=len(phase_name(1))), dimension(:), allocatable :: namesNA + character(len=len(phase_name(1))) :: a + character(len=*),parameter :: n = "NULL" + + integer(pInt) :: hdferr, NmatPoints, i, j, k + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace + + integer(HID_T) :: dt5_id ! Memory datatype identifier + integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size + + integer(HSIZE_T), dimension(2) :: counter + integer(HSSIZE_T), dimension(2) :: fileOffset + integer(pInt), dimension(:,:), allocatable :: arrOffset + + a = n + allocate(namesNA(0:size(phase_name)),source=[a,phase_name]) + NmatPoints = size(mapping,1)/Nconstituents + mapping_ID = HDF5_openGroup("current/mapGeometry") + + allocate(arrOffset(Nconstituents,NmatPoints)) + do i=1_pInt, NmatPoints + do k=1_pInt, Nconstituents + do j=1_pInt, size(phase_name) + if(material_phase(k,1,i) == j) & + arrOffset(k,i) = mpiOffset_phase(j) + enddo + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(2, int([Nconstituents,dataspace_size],HSIZE_T), space_id, hdferr, & + int([Nconstituents,dataspace_size],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') + +!-------------------------------------------------------------------------------------------------- +! compound type + ! First calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) + typesize = len(phase_name(1)) + CALL h5tset_size_f(dt5_id, typesize, hdferr) + CALL h5tget_size_f(dt5_id, type_sizec, hdferr) + CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr) + type_size = type_sizec + type_sizei + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 0') + call h5tinsert_f(dtype_id, "Position", type_sizec, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 2') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, 'constitutive', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase') + +!-------------------------------------------------------------------------------------------------- +! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f instance_id') + call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f instance_id') + + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- +! Define and select hyperslabs + counter(1) = Nconstituents ! how big i am + counter(2) = NmatPoints + fileOffset(1) = 0 ! where i start to write my data + fileOffset(2) = mpiOffset + + call h5screate_simple_f(2, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pset_dxpl_mpio_f') + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, name_id, reshape(namesNA(mapping),[Nconstituents,NmatPoints]), & + int([Nconstituents, dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f position_id') + + call h5dwrite_f(dset_id, position_id, reshape(mapping2-1_pInt,[Nconstituents,NmatPoints])+arrOffset, & + int([Nconstituents, dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- +! close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f position_id') + call h5tclose_f(name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f instance_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + +end subroutine HDF5_mappingPhase + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the backward mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_backwardMappingPhase(material_phase,phasememberat,phase_name,dataspace_size,mpiOffset,mpiOffset_phase) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:,:) :: material_phase, phasememberat + character(len=*), intent(in), dimension(:) :: phase_name + integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_phase + integer(pInt), intent(in) :: mpiOffset + + integer(pInt) :: hdferr, NmatPoints, Nconstituents, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace + integer(SIZE_T) :: type_size + + integer(pInt), dimension(:,:), allocatable :: arr + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + + character(len=64) :: phaseID + + Nconstituents = size(phasememberat,1) + NmatPoints = count(material_phase /=0_pInt)/Nconstituents + + allocate(arr(2,NmatPoints*Nconstituents)) + + do i=1_pInt, NmatPoints + do j=Nconstituents-1_pInt, 0_pInt, -1_pInt + arr(1,Nconstituents*i-j) = i-1_pInt + enddo + enddo + arr(2,:) = pack(material_phase,material_phase/=0_pInt) + + + do i=1_pInt, size(phase_name) + write(phaseID, '(i0)') i + mapping_ID = HDF5_openGroup('/current/constitutive/'//trim(phaseID)//'_'//phase_name(i)) + NmatPoints = count(material_phase == i) + +!-------------------------------------------------------------------------------------------------- + ! create dataspace + call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, & + int([dataspace_size(i)],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') + +!-------------------------------------------------------------------------------------------------- + ! compound type + call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f 0') + +!-------------------------------------------------------------------------------------------------- + ! create Dataset + call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase') + +!-------------------------------------------------------------------------------------------------- + ! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- + ! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset_phase(i) ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pset_dxpl_mpio_f') + +!-------------------------------------------------------------------------------------------------- + ! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset, int([dataspace_size(i)],HSIZE_T),& + hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- + !close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f position_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + enddo + +end subroutine HDF5_backwardMappingPhase + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat + character(len=*), intent(in), dimension(:) :: homogenization_name + integer(pInt), intent(in), dimension(:) :: mpiOffset_homog + integer(pInt), intent(in) :: dataspace_size, mpiOffset + + integer(pInt) :: hdferr, NmatPoints, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace + + integer(HID_T) :: dt5_id ! Memory datatype identifier + integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + integer(pInt), dimension(:), allocatable :: arrOffset + + NmatPoints = count(material_homog /=0_pInt) + mapping_ID = HDF5_openGroup("current/mapGeometry") + + allocate(arrOffset(NmatPoints)) + do i=1_pInt, NmatPoints + do j=1_pInt, size(homogenization_name) + if(material_homog(1,i) == j) & + arrOffset(i) = mpiOffset_homog(j) + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, & + int([dataspace_size],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') + +!-------------------------------------------------------------------------------------------------- +! compound type + ! First calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) + typesize = len(homogenization_name(1)) + CALL h5tset_size_f(dt5_id, typesize, hdferr) + CALL h5tget_size_f(dt5_id, type_sizec, hdferr) + CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr) + type_size = type_sizec + type_sizei + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 0') + call h5tinsert_f(dtype_id, "Position", type_sizec, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 2') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, 'homogenization', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog') + +!-------------------------------------------------------------------------------------------------- +! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f instance_id') + call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f instance_id') + + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- +! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! Create property list for collective dataset write + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pset_dxpl_mpio_f') + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, name_id, homogenization_name(pack(material_homog,material_homog/=0_pInt)), & + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f position_id') + + call h5dwrite_f(dset_id, position_id, pack(homogmemberat-1_pInt,homogmemberat/=0_pInt) + arrOffset, & + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f position_id') + call h5tclose_f(name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f instance_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + +end subroutine HDF5_mappingHomog + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the backward mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_backwardMappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat + character(len=*), intent(in), dimension(:) :: homogenization_name + integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_homog + integer(pInt), intent(in) :: mpiOffset + + integer(pInt) :: hdferr, NmatPoints, i + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace + integer(SIZE_T) :: type_size + + integer(pInt), dimension(:,:), allocatable :: arr + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + + character(len=64) :: homogID + + NmatPoints = count(material_homog /=0_pInt) + allocate(arr(2,NmatPoints)) + + arr(1,:) = (/(i, i=0_pint,NmatPoints-1_pInt)/) + arr(2,:) = pack(material_homog,material_homog/=0_pInt) + + do i=1_pInt, size(homogenization_name) + write(homogID, '(i0)') i + mapping_ID = HDF5_openGroup('/current/homogenization/'//trim(homogID)//'_'//homogenization_name(i)) + +!-------------------------------------------------------------------------------------------------- + ! create dataspace + call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, & + int([dataspace_size(i)],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') + +!-------------------------------------------------------------------------------------------------- + ! compound type + call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f 0') + +!-------------------------------------------------------------------------------------------------- + ! create Dataset + call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog') + +!-------------------------------------------------------------------------------------------------- + ! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- + ! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset_homog(i) ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pset_dxpl_mpio_f') + +!-------------------------------------------------------------------------------------------------- + ! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset,int([dataspace_size(i)],HSIZE_T),& + hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- + !close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f position_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + enddo + +end subroutine HDF5_backwardMappingHomog + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: crystalliteAt + integer(pInt), intent(in), dimension(:,:,:) :: crystmemberAt + character(len=*), intent(in), dimension(:) :: crystallite_name + integer(pInt), intent(in), dimension(:) :: mpiOffset_cryst + integer(pInt), intent(in) :: dataspace_size, mpiOffset + + integer :: hdferr + integer(pInt) :: NmatPoints, Nconstituents, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, plist_id, memspace + integer(HID_T), dimension(:), allocatable :: position_id + + integer(HID_T) :: dt5_id ! Memory datatype identifier + integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + integer(pInt), dimension(:), allocatable :: arrOffset + + character(len=64) :: m + + Nconstituents = size(crystmemberAt,1) + NmatPoints = count(crystalliteAt /=0_pInt) + mapping_ID = HDF5_openGroup("current/mapGeometry") + + allocate(position_id(Nconstituents)) + + allocate(arrOffset(NmatPoints)) + do i=1_pInt, NmatPoints + do j=1_pInt, size(crystallite_name) + if(crystalliteAt(1,i) == j) & + arrOffset(i) = Nconstituents*mpiOffset_cryst(j) + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, & + int([dataspace_size],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') + +!-------------------------------------------------------------------------------------------------- +! compound type + ! First calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) + typesize = len(crystallite_name(1)) + CALL h5tset_size_f(dt5_id, typesize, hdferr) + CALL h5tget_size_f(dt5_id, type_sizec, hdferr) + CALL h5tget_size_f(H5T_STD_I32LE, type_sizei, hdferr) + type_size = type_sizec + type_sizei*Nconstituents + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 0') + do i=1_pInt, Nconstituents + write(m, '(i0)') i + call h5tinsert_f(dtype_id, "Position "//trim(m), type_sizec+(i-1)*type_sizei, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 2 '//trim(m)) + enddo + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, 'crystallite', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite') + +!-------------------------------------------------------------------------------------------------- +! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f instance_id') + call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f instance_id') + + do i=1_pInt, Nconstituents + write(m, '(i0)') i + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id(i), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f position_id') + call h5tinsert_f(position_id(i), "Position "//trim(m), 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f position_id') + enddo + +!-------------------------------------------------------------------------------------------------- +! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pset_dxpl_mpio_f') + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, name_id, crystallite_name(pack(crystalliteAt,crystalliteAt/=0_pInt)), & + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f position_id') + + do i=1_pInt, Nconstituents + call h5dwrite_f(dset_id, position_id(i), pack(crystmemberAt(i,:,:)-1_pInt,crystmemberAt(i,:,:)/=0_pInt)+arrOffset,& + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f instance_id') + enddo + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f dtype_id') + do i=1_pInt, Nconstituents + call h5tclose_f(position_id(i), hdferr) + enddo + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f position_id') + call h5tclose_f(name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f instance_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + +end subroutine HDF5_mappingCrystallite + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the backward mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_backwardMappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: crystalliteAt + integer(pInt), intent(in), dimension(:,:,:) :: crystmemberAt + character(len=*), intent(in), dimension(:) :: crystallite_name + integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_cryst + integer(pInt), intent(in) :: mpiOffset + + integer :: hdferr + integer(pInt) :: NmatPoints, Nconstituents, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace + integer(SIZE_T) :: type_size + + integer(pInt), dimension(:,:), allocatable :: h_arr, arr + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + + character(len=64) :: crystallID + + Nconstituents = size(crystmemberAt,1) + NmatPoints = count(crystalliteAt /=0_pInt) + + allocate(h_arr(2,NmatPoints)) + allocate(arr(2,Nconstituents*NmatPoints)) + + h_arr(1,:) = (/(i, i=0_pInt,NmatPoints-1_pInt)/) + h_arr(2,:) = pack(crystalliteAt,crystalliteAt/=0_pInt) + + do i=1_pInt, NmatPoints + do j=Nconstituents-1_pInt, 0_pInt, -1_pInt + arr(1,Nconstituents*i-j) = h_arr(1,i) + arr(2,Nconstituents*i-j) = h_arr(2,i) + enddo + enddo + + + do i=1_pInt, size(crystallite_name) + if (crystallite_name(i) == 'none') cycle + write(crystallID, '(i0)') i + mapping_ID = HDF5_openGroup('/current/crystallite/'//trim(crystallID)//'_'//crystallite_name(i)) + NmatPoints = count(crystalliteAt == i) + +!-------------------------------------------------------------------------------------------------- + ! create dataspace + call h5screate_simple_f(1, int([Nconstituents*dataspace_size(i)],HSIZE_T), space_id, hdferr, & + int([Nconstituents*dataspace_size(i)],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') + +!-------------------------------------------------------------------------------------------------- + ! compound type + call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f 0') + +!-------------------------------------------------------------------------------------------------- + ! create Dataset + call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite') + +!-------------------------------------------------------------------------------------------------- + ! Create memory types + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- + ! Define and select hyperslabs + counter = Nconstituents*NmatPoints ! how big i am + fileOffset = Nconstituents*mpiOffset_cryst(i) ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pset_dxpl_mpio_f') + +!-------------------------------------------------------------------------------------------------- + ! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i) + mpiOffset,& + int([Nconstituents*dataspace_size(i)],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- + !close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f position_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + enddo + +end subroutine HDF5_backwardMappingCrystallite + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique cell to node mapping +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingCells(mapping) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:) :: mapping + + integer :: hdferr, Nnodes + integer(HID_T) :: mapping_id, dset_id, space_id + + Nnodes=size(mapping) + mapping_ID = HDF5_openGroup("mapping") + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(1, int([Nnodes],HSIZE_T), space_id, hdferr, & + int([Nnodes],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5screate_simple_f') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, "Cell",H5T_NATIVE_INTEGER, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells') + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, mapping, int([Nnodes],HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5sclose_f') + call HDF5_closeGroup(mapping_ID) + +end subroutine HDF5_mappingCells + + + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addTensor3DDataset(group,Nnodes,tensorSize,label,SIunit) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + integer(pInt), intent(in) :: Nnodes, tensorSize + character(len=*), intent(in) :: SIunit, label + + integer :: hdferr + integer(HID_T) :: space_id, dset_id + integer(HSIZE_T), dimension(3) :: dataShape + + dataShape = int([tensorSize,tensorSize,Nnodes], HSIZE_T) + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(3, dataShape, space_id, hdferr, dataShape) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addTensor3DDataset: h5screate_simple_f') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(group, trim(label),H5T_NATIVE_DOUBLE, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addTensor3DDataset: h5dcreate_f') + call HDF5_addStringAttribute(dset_id,'unit',trim(SIunit)) + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addTensor3DDataset: h5dclose_f') + call h5sclose_f(space_id, hdferr) + +end subroutine HDF5_addTensor3DDataset + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_writeVectorDataset(group,dataset,label,SIunit,dataspace_size,mpiOffset) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + character(len=*), intent(in) :: SIunit,label + integer(pInt), intent(in) :: dataspace_size, mpiOffset + real(pReal), intent(in), dimension(:,:) :: dataset + + integer :: hdferr, vectorSize + integer(HID_T) :: dset_id, space_id, memspace, plist_id + + integer(HSIZE_T), dimension(2) :: counter + integer(HSSIZE_T), dimension(2) :: fileOffset + + if(any(shape(dataset) == 0)) return + + vectorSize = size(dataset,1) + + call HDF5_addVectorDataset(group,dataspace_size,vectorSize,label,SIunit) ! here nNodes need to be global + call h5dopen_f(group, label, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5dopen_f') + + ! Define and select hyperslabs + counter(1) = vectorSize ! how big i am + counter(2) = size(dataset,2) + fileOffset(1) = 0 ! where i start to write my data + fileOffset(2) = mpiOffset + + call h5screate_simple_f(2, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5sselect_hyperslab_f') + + ! Create property list for collective dataset write + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5pset_dxpl_mpio_f') + + ! Write the dataset collectively + call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([vectorSize, dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5dwrite_f') + + call h5sclose_f(space_id, hdferr) + call h5sclose_f(memspace, hdferr) + call h5dclose_f(dset_id, hdferr) + call h5pclose_f(plist_id, hdferr) + +end subroutine HDF5_writeVectorDataset + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +! by default, a 3x3 tensor is assumed +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_writeTensorDataset(group,dataset,label,SIunit,dataspace_size,mpiOffset) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + character(len=*), intent(in) :: SIunit,label + integer(pInt), intent(in) :: dataspace_size, mpiOffset + real(pReal), intent(in), dimension(:,:,:) :: dataset + + integer :: hdferr, tensorSize + integer(HID_T) :: dset_id, space_id, memspace, plist_id + + integer(HSIZE_T), dimension(3) :: counter + integer(HSSIZE_T), dimension(3) :: fileOffset + + if(any(shape(dataset) == 0)) return + + tensorSize = size(dataset,1) + + call HDF5_addTensor3DDataset(group,dataspace_size,tensorSize,label,SIunit) + call h5dopen_f(group, label, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5dopen_f') + + ! Define and select hyperslabs + counter(1) = tensorSize ! how big i am + counter(2) = tensorSize + counter(3) = size(dataset,3) + fileOffset(1) = 0 ! where i start to write my data + fileOffset(2) = 0 + fileOffset(3) = mpiOffset + + call h5screate_simple_f(3, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5sselect_hyperslab_f') + + ! Create property list for collective dataset write + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5pset_dxpl_mpio_f') + + ! Write the dataset collectively + call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([tensorSize, dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5dwrite_f') + + call h5sclose_f(space_id, hdferr) + call h5sclose_f(memspace, hdferr) + call h5dclose_f(dset_id, hdferr) + call h5pclose_f(plist_id, hdferr) + + end subroutine HDF5_writeTensorDataset + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addVectorDataset(group,nnodes,vectorSize,label,SIunit) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + integer(pInt), intent(in) :: nnodes,vectorSize + character(len=*), intent(in) :: SIunit,label + + integer :: hdferr + integer(HID_T) :: space_id, dset_id + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(2, int([vectorSize,Nnodes],HSIZE_T), space_id, hdferr, & + int([vectorSize,Nnodes],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addVectorDataset: h5screate_simple_f') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(group, trim(label), H5T_NATIVE_DOUBLE, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addVectorDataset: h5dcreate_f') + call HDF5_addStringAttribute(dset_id,'unit',trim(SIunit)) + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addVectorDataset: h5dclose_f') + call h5sclose_f(space_id, hdferr) + +end subroutine HDF5_addVectorDataset + + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_writeScalarDataset(group,dataset,label,SIunit,dataspace_size,mpiOffset) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + character(len=*), intent(in) :: SIunit,label + integer(pInt), intent(in) :: dataspace_size, mpiOffset + real(pReal), intent(in), dimension(:) :: dataset + + integer :: hdferr, nNodes + integer(HID_T) :: dset_id, space_id, memspace, plist_id + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + + nNodes = size(dataset) + if (nNodes < 1) return + + call HDF5_addScalarDataset(group,dataspace_size,label,SIunit) + call h5dopen_f(group, label, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5dopen_f') + + ! Define and select hyperslabs + counter = size(dataset) ! how big i am + fileOffset = mpiOffset ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5sselect_hyperslab_f') + + ! Create property list for collective dataset write + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5pset_dxpl_mpio_f') + + ! Write the dataset collectively + call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5dwrite_f') + + call h5sclose_f(space_id, hdferr) + call h5sclose_f(memspace, hdferr) + call h5dclose_f(dset_id, hdferr) + call h5pclose_f(plist_id, hdferr) + +end subroutine HDF5_writeScalarDataset + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addScalarDataset(group,nnodes,label,SIunit) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + integer(pInt), intent(in) :: nnodes + character(len=*), intent(in) :: SIunit,label + + integer :: hdferr + integer(HID_T) :: space_id, dset_id + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(1, int([Nnodes],HSIZE_T), space_id, hdferr, & + int([Nnodes],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addScalarDataset: h5screate_simple_f') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(group, trim(label),H5T_NATIVE_DOUBLE, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addScalarDataset: h5dcreate_f') + call HDF5_addStringAttribute(dset_id,'unit',trim(SIunit)) + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addScalarDataset: h5dclose_f') + call h5sclose_f(space_id, hdferr) + +end subroutine HDF5_addScalarDataset + + + +!-------------------------------------------------------------------------------------------------- +!> @brief copies the current temp results to the actual results file +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_forwardResults(time) + use hdf5 + use IO, only: & + IO_intOut + + implicit none + integer :: hdferr + real(pReal), intent(in) :: time + character(len=1024) :: myName + + currentInc = currentInc +1_pInt + write(6,*) 'forward results';flush(6) + write(myName,'(a,'//IO_intOut(currentInc)//')') 'inc',currentInc + currentIncID = HDF5_addGroup(myName) + call HDF5_setLink(myName,'current') +! call HDF5_flush(resultsFile) + call HDF5_closeGroup(currentIncID) + +end subroutine HDF5_forwardResults + +end module HDF5_Utilities From b305d9133fb5e3c664e9426ff241fd0c0a4dab84 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 09:12:30 +0200 Subject: [PATCH 091/208] avoid timeouts if Abaqus is used by someone else --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 50eb21714..9d3b6c858 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 50eb21714e2f501b111bb62096ebb6a5bfc6708a +Subproject commit 9d3b6c858243ec6d7c1f8425e78be59bfdd6e110 From f0645d84f597d8cf97ebf94f59b4ea8f331f04c1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 22:22:21 +0200 Subject: [PATCH 092/208] not a target anymore --- src/plastic_phenopowerlaw.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index f91ba28ae..bdc6e12a6 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -86,7 +86,7 @@ module plastic_phenopowerlaw sumF end type - type(tPhenopowerlawState), allocatable, dimension(:), target, private :: & + type(tPhenopowerlawState), allocatable, dimension(:), private :: & dotState, & state From 5b409fd6f7c3f13361bd440040ab1de585aa8492 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 16:16:50 +0200 Subject: [PATCH 093/208] type mismatch --- src/HDF5_utilities.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index bb09da7f7..b878543a1 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -187,7 +187,7 @@ subroutine HDF5_closeGroup(ID) integer :: hdferr call h5gclose_f(ID, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = ID) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = int(ID,pInt)) end subroutine HDF5_closeGroup From c8aa9ff3efe0b1ebd09fd61e85000be030d4c0b1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 19:30:36 +0200 Subject: [PATCH 094/208] merge-related fixes --- PRIVATE | 2 +- lib/damask/config/material.py | 13 +++++++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 9d3b6c858..ae79bc96d 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 9d3b6c858243ec6d7c1f8425e78be59bfdd6e110 +Subproject commit ae79bc96d9dd1fd5ea06b916b0be098169f34a1e diff --git a/lib/damask/config/material.py b/lib/damask/config/material.py index af635dd92..02658019d 100644 --- a/lib/damask/config/material.py +++ b/lib/damask/config/material.py @@ -277,3 +277,16 @@ class Material(): self.data[part.lower()][section.lower()][key.lower()] = value if newlen is not oldlen: print('Length of value was changed from %i to %i!'%(oldlen,newlen)) + + + def add_value(self, part=None, + section=None, + key=None, + value=None): + if not isinstance(value,list): + if not isinstance(value,str): + value = '%s'%value + value = [value] + print('adding %s:%s:%s with value %s '%(part.lower(),section.lower(),key.lower(),value)) + self.data[part.lower()][section.lower()][key.lower()] = value + self.data[part.lower()][section.lower()]['__order__'] += [key.lower()] From eebff83252495f45cb9e79f2ff6b94408c9f301e Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 3 Aug 2018 22:06:36 +0200 Subject: [PATCH 095/208] [skip ci] updated version information after successful test of v2.0.2-263-gb305d913 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index fca0385fb..8ef11d745 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-261-gbc3f6ae9 +v2.0.2-263-gb305d913 From 8edeeaf2135acf428990ba8098db641bc8ff4ad7 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 3 Aug 2018 19:39:14 -0400 Subject: [PATCH 096/208] renaming of p_vec and friends to names based on "group" --- src/material.f90 | 10 +++++----- src/prec.f90 | 8 ++++---- src/vacancyflux_cahnhilliard.f90 | 4 ++-- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index d71fbb37a..c2c52aaa6 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -16,8 +16,8 @@ module material tSourceState, & tHomogMapping, & tPhaseMapping, & - p_vec, & - p_intvec + group_scalar, & + group_int implicit none private @@ -268,7 +268,7 @@ module material porosityMapping, & !< mapping for porosity state/fields hydrogenfluxMapping !< mapping for hydrogen conc state/fields - type(p_vec), allocatable, dimension(:), public :: & + type(group_scalar), allocatable, dimension(:), public :: & temperature, & !< temperature field damage, & !< damage field vacancyConc, & !< vacancy conc field @@ -1120,8 +1120,8 @@ subroutine material_populateGrains phaseID,textureID,dGrains,myNgrains,myNorientations,myNconstituents, & grain,constituentGrain,ipGrain,symExtension, ip real(pReal) :: deviation,extreme,rnd - integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array - type(p_intvec), dimension (:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array + integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array + type(group_int), dimension (:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array myDebug = debug_level(debug_material) diff --git a/src/prec.f90 b/src/prec.f90 index 2cdc533b6..f5b41b873 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -28,13 +28,13 @@ module prec integer(pInt), allocatable, dimension(:) :: realloc_lhs_test - type, public :: p_vec !< variable length datatype used for storage of state + type, public :: group_scalar !< variable length datatype used for storage of state real(pReal), dimension(:), pointer :: p - end type p_vec + end type group_scalar - type, public :: p_intvec + type, public :: group_int integer(pInt), dimension(:), pointer :: p - end type p_intvec + end type group_int !http://stackoverflow.com/questions/3948210/can-i-have-a-pointer-to-an-item-in-an-allocatable-array type, public :: tState diff --git a/src/vacancyflux_cahnhilliard.f90 b/src/vacancyflux_cahnhilliard.f90 index cde2cb233..96fd50d64 100644 --- a/src/vacancyflux_cahnhilliard.f90 +++ b/src/vacancyflux_cahnhilliard.f90 @@ -7,7 +7,7 @@ module vacancyflux_cahnhilliard use prec, only: & pReal, & pInt, & - p_vec + group_scalar implicit none private @@ -26,7 +26,7 @@ module vacancyflux_cahnhilliard real(pReal), dimension(:), allocatable, private :: & vacancyflux_cahnhilliard_flucAmplitude - type(p_vec), dimension(:), allocatable, private :: & + type(group_scalar), dimension(:), allocatable, private :: & vacancyflux_cahnhilliard_thermalFluc real(pReal), parameter, private :: & From 20d1264d0705a30e77c4fd5d01532d69b7c09724 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 4 Aug 2018 13:58:01 +0200 Subject: [PATCH 097/208] small improvements default case of error handling, checking for recursion limit, some comments to also understand it later --- src/IO.f90 | 68 +++++++++++++++++++++++++++++++++++------------------- 1 file changed, 44 insertions(+), 24 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 94e429324..c9e93b498 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -176,48 +176,65 @@ end function IO_read !> @brief recursively reads a text file. !! Recursion is triggered by "{path/to/inputfile}" in a line !-------------------------------------------------------------------------------------------------- -recursive function IO_recursiveRead(fileName) result(fileContent) +recursive function IO_recursiveRead(fileName,cnt) result(fileContent) implicit none - character(len=*), intent(in) :: fileName - character(len=256), dimension(:), allocatable :: fileContent + character(len=*), intent(in) :: fileName + integer(pInt), intent(in), optional :: cnt !< recursion counter + character(len=256), dimension(:), allocatable :: fileContent !< file content, separated per lines character(len=256), dimension(:), allocatable :: includedContent - character(len=256) :: line - character(len=:), allocatable :: rawData - integer(pInt) :: fileLength, fileUnit,startPos,endPos,& - myTotalLines,l,includedLines, missingLines,i + character(len=256) :: line + character(len=256), parameter :: dummy = 'https://damask.mpie.de' !< to fill up remaining array + character(len=:), allocatable :: rawData + integer(pInt) :: & + fileLength, & + fileUnit, & + startPos, endPos, & + myTotalLines, & !< # lines read from file without include statements + includedLines, & !< # lines included from other file(s) + missingLines, & !< # lines missing from current file + l,i + if (merge(cnt,0_pInt,present(cnt))>10_pInt) call IO_error(106_pInt,ext_msg=trim(fileName)) + +!-------------------------------------------------------------------------------------------------- +! read data as stream inquire(file = fileName, size=fileLength) open(newunit=fileUnit, file = fileName, access = "STREAM") allocate(character(len=fileLength)::rawData) read(fileUnit) rawData close(fileUnit) - myTotalLines = 0 - do l=1, len(rawData) +!-------------------------------------------------------------------------------------------------- +! count lines to allocate string array + myTotalLines = 0_pInt + do l=1_pInt, len(rawData) if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1 enddo allocate(fileContent(myTotalLines)) - startPos = 1 - endPos = 0 +!-------------------------------------------------------------------------------------------------- +! split raw data at end of line and handle includes + startPos = 1_pInt + endPos = 0_pInt - includedLines=0 - l=0 + includedLines=0_pInt + l=0_pInt do while (startPos <= len(rawData)) - l = l + 1 + l = l + 1_pInt endPos = endPos + scan(rawData(startPos:),new_line('')) - if(endPos - startPos >256) write(6,*) 'mist' - line = rawData(startPos:endPos-1) - startPos = endPos + 1 + if(endPos - startPos >256) call IO_error(107_pInt,ext_msg=trim(fileName)) + line = rawData(startPos:endPos-1_pInt) + startPos = endPos + 1_pInt recursion: if(scan(trim(line),'{') < scan(trim(line),'}')) then - myTotalLines = myTotalLines - 1 - includedContent = IO_recursiveRead(trim(line(scan(line,'{')+1:scan(line,'}')-1))) - includedLines = includedLines +size(includedContent) - missingLines = myTotalLines+includedLines - size(fileContent(1:l-1)) -size(includedContent) - fileContent = [fileContent(1:l-1),includedContent,[(line,i=1,missingLines)]] - l=l-1+size(includedContent) + myTotalLines = myTotalLines - 1_pInt + includedContent = IO_recursiveRead(trim(line(scan(line,'{')+1_pInt:scan(line,'}')-1_pInt)), & + merge(cnt,1_pInt,present(cnt))) ! to track recursion depth + includedLines = includedLines + size(includedContent) + missingLines = myTotalLines + includedLines - size(fileContent(1:l-1)) -size(includedContent) + fileContent = [ fileContent(1:l-1_pInt), includedContent, [(dummy,i=1,missingLines)] ] ! add content and grow array + l = l - 1_pInt + size(includedContent) else recursion fileContent(l) = line endif recursion @@ -226,6 +243,7 @@ recursive function IO_recursiveRead(fileName) result(fileContent) end function IO_recursiveRead + !-------------------------------------------------------------------------------------------------- !> @brief checks if unit is opened for reading, if true rewinds. Otherwise stops with !! error message @@ -233,7 +251,7 @@ end function IO_recursiveRead subroutine IO_checkAndRewind(fileUnit) implicit none - integer(pInt), intent(in) :: fileUnit !< file unit + integer(pInt), intent(in) :: fileUnit !< file unit logical :: fileOpened character(len=15) :: fileRead @@ -1568,6 +1586,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'unknown output:' case (106_pInt) msg = 'working directory does not exist:' + case (107_pInt) + msg = 'line length exceeds limit of 256' !-------------------------------------------------------------------------------------------------- ! lattice error messages From e6d5f1926fbab636eb3e62a3d1993d7f67e1368c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 4 Aug 2018 14:35:57 +0200 Subject: [PATCH 098/208] issue of heap size still not finally resolved --- env/DAMASK.csh | 4 +++- env/DAMASK.sh | 4 +++- env/DAMASK.zsh | 4 +++- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/env/DAMASK.csh b/env/DAMASK.csh index 26e2dd8a2..07b4b6817 100644 --- a/env/DAMASK.csh +++ b/env/DAMASK.csh @@ -19,7 +19,9 @@ if ( "x$DAMASK_NUM_THREADS" == "x" ) then endif # currently, there is no information that unlimited causes problems -# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# more info https://jblevins.org/log/segfault +# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap # http://superuser.com/questions/220059/what-parameters-has-ulimit limit datasize unlimited # maximum heap size (kB) limit stacksize unlimited # maximum stack size (kB) diff --git a/env/DAMASK.sh b/env/DAMASK.sh index 509f5f1b7..663e9a4b3 100644 --- a/env/DAMASK.sh +++ b/env/DAMASK.sh @@ -42,7 +42,9 @@ PROCESSING=$(type -p postResults || true 2>/dev/null) [ "x$DAMASK_NUM_THREADS" == "x" ] && DAMASK_NUM_THREADS=1 # currently, there is no information that unlimited causes problems -# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# more info https://jblevins.org/log/segfault +# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap # http://superuser.com/questions/220059/what-parameters-has-ulimit ulimit -d unlimited 2>/dev/null # maximum heap size (kB) ulimit -s unlimited 2>/dev/null # maximum stack size (kB) diff --git a/env/DAMASK.zsh b/env/DAMASK.zsh index 3ceeb116a..43f682865 100644 --- a/env/DAMASK.zsh +++ b/env/DAMASK.zsh @@ -33,7 +33,9 @@ PROCESSING=$(which postResults || true 2>/dev/null) [ "x$DAMASK_NUM_THREADS" = "x" ] && DAMASK_NUM_THREADS=1 # currently, there is no information that unlimited causes problems -# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# more info https://jblevins.org/log/segfault +# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap # http://superuser.com/questions/220059/what-parameters-has-ulimit ulimit -d unlimited 2>/dev/null # maximum heap size (kB) ulimit -s unlimited 2>/dev/null # maximum stack size (kB) From 9360c171a1eb15590abcdfdb5652f764b25e05b8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 4 Aug 2018 19:39:50 +0200 Subject: [PATCH 099/208] polished for merge access to array(n+m:) is safe for array of size n with m>1 --- src/config.f90 | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 6c92ff95a..c99b14c00 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -107,13 +107,13 @@ subroutine config_init() debug_levelBasic implicit none - integer(pInt) :: myDebug,i + integer(pInt) :: myDebug,i character(len=256) :: & line, & part character(len=256), dimension(:), allocatable :: fileContent - logical :: jobSpecificConfig + logical :: fileExists write(6,'(/,a)') ' <<<+- config init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -121,12 +121,12 @@ subroutine config_init() myDebug = debug_level(debug_material) - inquire(file=trim(getSolverJobName())//'.'//material_localFileExt,exist=jobSpecificConfig) - if(jobSpecificConfig) then + inquire(file=trim(getSolverJobName())//'.'//material_localFileExt,exist=fileExists) + if(fileExists) then fileContent = IO_recursiveRead(trim(getSolverJobName())//'.'//material_localFileExt) else - inquire(file='material.config',exist=jobSpecificConfig) - if(.not. jobSpecificConfig) call IO_error(0_pInt) + inquire(file='material.config',exist=fileExists) + if(.not. fileExists) call IO_error(100_pInt,ext_msg='material.config') fileContent = IO_recursiveRead('material.config') endif @@ -136,7 +136,7 @@ subroutine config_init() select case (trim(part)) case (trim(material_partPhase)) - call parseFile(line,phase_name,config_phase,fileContent(i+1:)) !(i+1:) save for empty part at (at end of file)? + call parseFile(line,phase_name,config_phase,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) case (trim(material_partMicrostructure)) @@ -158,7 +158,6 @@ subroutine config_init() end select enddo - deallocate(fileContent) material_Nhomogenization = size(config_homogenization) if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) @@ -233,6 +232,9 @@ subroutine parseFile(line,& end subroutine parseFile +!-------------------------------------------------------------------------------------------------- +!> @brief deallocates the linked lists that store the content of the configuration files +!-------------------------------------------------------------------------------------------------- subroutine config_deallocate(what) use IO, only: & IO_error @@ -281,6 +283,12 @@ subroutine config_deallocate(what) end subroutine config_deallocate +!################################################################################################## +! The folowing functions are part of the tPartitionedStringList object +!################################################################################################## + + + !-------------------------------------------------------------------------------------------------- !> @brief add element !> @details Adds a string together with the start/end position of chunks in this string. The new From fa0dff7ac8796256e5d1ead0f121391994209093 Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 4 Aug 2018 21:51:25 +0200 Subject: [PATCH 100/208] [skip ci] updated version information after successful test of v2.0.2-282-gc05337a2 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 8ef11d745..6ab575d5c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-263-gb305d913 +v2.0.2-282-gc05337a2 From d623d0379be398f79c3d9e6b861022233a8b0804 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 4 Aug 2018 22:38:38 +0200 Subject: [PATCH 101/208] resolved confusion of different branches in PRIVATE --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 58fcddbe6..67fcdfd00 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 58fcddbe62a071d027c0e2a876f07483b2d1e20e +Subproject commit 67fcdfd001a9e4f3da56d72ebeb0ea16d6d613e6 From 661636d83ec0b532635c8a6e400f1b55c03541b7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 4 Aug 2018 22:53:56 +0200 Subject: [PATCH 102/208] default values needed to suppress error in case of missing key --- src/lattice.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index f75745433..2b7fe5774 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1417,15 +1417,15 @@ subroutine lattice_init a_fcc(p) = config_phase(p)%getFloat('a_fcc',defaultVal=0.0_pReal) a_bcc(p) = config_phase(p)%getFloat('a_bcc',defaultVal=0.0_pReal) - lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11') - lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22') - lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33') + lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11',defaultVal=0.0_pReal) + lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22',defaultVal=0.0_pReal) + lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33',defaultVal=0.0_pReal) - temp = config_phase(p)%getFloats('thermal_expansion11') ! read up to three parameters (constant, linear, quadratic with T) + temp = config_phase(p)%getFloats('thermal_expansion11',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) lattice_thermalExpansion33(1,1,1:size(temp),p) = temp - temp = config_phase(p)%getFloats('thermal_expansion22') ! read up to three parameters (constant, linear, quadratic with T) + temp = config_phase(p)%getFloats('thermal_expansion22',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) lattice_thermalExpansion33(2,2,1:size(temp),p) = temp - temp = config_phase(p)%getFloats('thermal_expansion33') ! read up to three parameters (constant, linear, quadratic with T) + temp = config_phase(p)%getFloats('thermal_expansion33',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) lattice_thermalExpansion33(3,3,1:size(temp),p) = temp lattice_specificHeat(p) = config_phase(p)%getFloat( 'specific_heat',defaultVal=0.0_pReal) From 2be13b0047366f4160516e70c596399b620351a8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 06:02:33 +0200 Subject: [PATCH 103/208] test that also works for new nonlocal --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 67fcdfd00..3d5f71743 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 67fcdfd001a9e4f3da56d72ebeb0ea16d6d613e6 +Subproject commit 3d5f71743d97eadb4b7ec3d110fe86bf1d6d83d6 From 60fc47ca2a41bc135ebca48a724e4a840fc4cfae Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 09:41:27 +0200 Subject: [PATCH 104/208] unused import --- src/spectral_thermal.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index 8e5b95ab9..4275c9533 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -65,8 +65,6 @@ subroutine spectral_thermal_init compiler_options #endif use IO, only: & - IO_intOut, & - IO_read_realFile, & IO_timeStamp use spectral_utilities, only: & wgt From c0adb613504586adec9252f3796f285612eb8058 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 10:41:01 +0200 Subject: [PATCH 105/208] outdated description --- src/spectral_interface.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index 1ab92a178..c3cb9141b 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -4,9 +4,8 @@ !> @brief Interfacing between the spectral solver and the material subroutines provided !! by DAMASK !> @details Interfacing between the spectral solver and the material subroutines provided -!> by DAMASK. Interpretating the command line arguments or, in case of called from f2py, -!> the arguments parsed to the init routine to get load case, geometry file, working -!> directory, etc. +!> by DAMASK. Interpretating the command line arguments to get load case, geometry file, +!> and working directory. !-------------------------------------------------------------------------------------------------- module DAMASK_interface use prec, only: & From 5337fb1229baab5e6a5e18fc3daf2ee0a138981f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 11:08:17 +0200 Subject: [PATCH 106/208] old runtime debugging leftovers --- src/constitutive.f90 | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9c3989a9c..7833f70cf 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -864,19 +864,11 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra FpArray !< plastic deformation gradient real(pReal), intent(in), dimension(6) :: & Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel) - integer(pLongInt) :: & - tick = 0_pLongInt, & - tock = 0_pLongInt, & - tickrate, & - maxticks integer(pInt) :: & ho, & !< homogenization tme, & !< thermal member position s !< counter in source loop - if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) & - call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) - ho = material_homog( ip,el) tme = thermalMapping(ho)%p(ip,el) @@ -957,13 +949,6 @@ subroutine constitutive_collectDeltaState(Tstar_v, Fe, ipc, ip, el) Fe !< elastic deformation gradient integer(pInt) :: & s !< counter in source loop - integer(pLongInt) :: & - tick, tock, & - tickrate, & - maxticks - - if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) & - call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_KINEHARDENING_ID) plasticityType From 686f0fe801abce250794f28eaccf8b58ef65a684 Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 5 Aug 2018 15:22:24 +0200 Subject: [PATCH 107/208] [skip ci] updated version information after successful test of v2.0.2-349-gd623d037 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6ab575d5c..7f5defebc 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-282-gc05337a2 +v2.0.2-349-gd623d037 From 8173b8ced1f01a5b278efe579a4f54baa3a811ff Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 5 Aug 2018 22:35:17 +0200 Subject: [PATCH 108/208] [skip ci] updated version information after successful test of v2.0.2-350-g2be13b00 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6ab575d5c..f5b06264c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-282-gc05337a2 +v2.0.2-350-g2be13b00 From 80841adcbbfad9b461df0c3132abb1b0bd631533 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 22:50:21 +0200 Subject: [PATCH 109/208] support python 3 soon --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 3d5f71743..737427a96 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3d5f71743d97eadb4b7ec3d110fe86bf1d6d83d6 +Subproject commit 737427a967e098e1cc82f69f5447fd1a02ffa855 From 3fbc537b7bbb378c49a737ca10714d74b99e72b1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 22:50:43 +0200 Subject: [PATCH 110/208] avoid deadlock for master pipelines --- .gitlab-ci.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0721f1374..114580f8d 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -418,6 +418,9 @@ createTar: script: - cd $(mktemp -d) - $DAMASKROOT/PRIVATE/releasing/deployMe.sh $CI_COMMIT_SHA + except: + - master + - release ################################################################################################### AbaqusStd: From 6c4ae60030190c6ba71981feefcff5c090fd0bf7 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 9 Aug 2018 00:03:41 +0200 Subject: [PATCH 111/208] [skip ci] updated version information after successful test of v2.0.2-357-g3fbc537b --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 7f5defebc..104e87fde 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-349-gd623d037 +v2.0.2-357-g3fbc537b From ba215ed9ea99faefb1be819ed2f5cdaf67e87ff2 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Mon, 13 Aug 2018 18:27:51 -0400 Subject: [PATCH 112/208] small polish --- src/prec.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/prec.f90 b/src/prec.f90 index f5b41b873..caf59cfe8 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -41,8 +41,8 @@ module prec integer(pInt) :: & sizeState = 0_pInt, & !< size of state sizeDotState = 0_pInt, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates - offsetDeltaState = 0_pInt, & !< offset of delta state - sizeDeltaState = 0_pInt, & !< size of delta state, i.e. state(offset+1:offset+sizeDot) follows time evolution by deltaState increments + offsetDeltaState = 0_pInt, & !< index offset of delta state + sizeDeltaState = 0_pInt, & !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments sizePostResults = 0_pInt !< size of output data real(pReal), pointer, dimension(:), contiguous :: & atolState @@ -146,7 +146,7 @@ logical elemental pure function dEq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - dEq = merge(.True., .False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + dEq = merge(.True.,.False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function dEq @@ -163,7 +163,7 @@ logical elemental pure function dNeq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - dNeq = merge(.False., .True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + dNeq = merge(.False.,.True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function dNeq @@ -180,7 +180,7 @@ logical elemental pure function dEq0(a,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.2250738585072014E-308 ! smallest non-denormalized number - dEq0 = merge(.True., .False.,abs(a) <= merge(tol,eps,present(tol))) + dEq0 = merge(.True.,.False.,abs(a) <= merge(tol,eps,present(tol))) end function dEq0 @@ -197,7 +197,7 @@ logical elemental pure function dNeq0(a,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.2250738585072014E-308 ! smallest non-denormalized number - dNeq0 = merge(.False., .True.,abs(a) <= merge(tol,eps,present(tol))) + dNeq0 = merge(.False.,.True.,abs(a) <= merge(tol,eps,present(tol))) end function dNeq0 @@ -215,7 +215,7 @@ logical elemental pure function cEq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - cEq = merge(.True., .False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + cEq = merge(.True.,.False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function cEq @@ -233,7 +233,7 @@ logical elemental pure function cNeq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - cNeq = merge(.False., .True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + cNeq = merge(.False.,.True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function cNeq end module prec From 2ea894dbbeec0571df07bac2b3c4d007cdc456e2 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 16 Aug 2018 03:16:13 +0200 Subject: [PATCH 113/208] [skip ci] updated version information after successful test of v2.0.2-374-g3e4f6598 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 104e87fde..943cac93c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-357-g3fbc537b +v2.0.2-374-g3e4f6598 From b64b5b82de263fb3eab2a450ae230e13b247869f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 17:06:03 +0200 Subject: [PATCH 114/208] integrationMode was always 1, very obscure code was most likely the leftover of old functionality --- src/crystallite.f90 | 70 ++++++++++++---------------------------- src/numerics.f90 | 11 +++---- src/plastic_nonlocal.f90 | 17 ++++------ 3 files changed, 31 insertions(+), 67 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index aea4fb993..88782751d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -114,6 +114,7 @@ module crystallite end enum integer(kind(undefined_ID)),dimension(:,:), allocatable, private :: & crystallite_outputID !< ID of each post result output + procedure(), pointer :: integrateState public :: & crystallite_init, & @@ -122,6 +123,7 @@ module crystallite crystallite_push33ToRef, & crystallite_postResults private :: & + integrateState, & crystallite_integrateStateFPI, & crystallite_integrateStateEuler, & crystallite_integrateStateAdaptiveEuler, & @@ -149,6 +151,7 @@ subroutine crystallite_init debug_crystallite, & debug_levelBasic use numerics, only: & + numerics_integrator, & worldrank, & usePingPong use math, only: & @@ -269,6 +272,20 @@ subroutine crystallite_init allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), & size(config_crystallite)), source=0_pInt) + select case(numerics_integrator(1)) + case(1_pInt) + integrateState => crystallite_integrateStateFPI + case(2_pInt) + integrateState => crystallite_integrateStateEuler + case(3_pInt) + integrateState => crystallite_integrateStateAdaptiveEuler + case(4_pInt) + integrateState => crystallite_integrateStateRK4 + case(5_pInt) + integrateState => crystallite_integrateStateRKCK45 + end select + + do c = 1_pInt, size(config_crystallite) #if defined(__GFORTRAN__) @@ -494,9 +511,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) subStepMinCryst, & subStepSizeCryst, & stepIncreaseCryst, & - nCryst, & - numerics_integrator, & - numerics_integrationMode, & numerics_timeSyncing use debug, only: & debug_level, & @@ -648,7 +662,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) endif singleRun NiterationCrystallite = 0_pInt - numerics_integrationMode = 1_pInt cutbackLooping: do while (any(crystallite_todo(:,startIP:endIP,FEsolving_execELem(1):FEsolving_execElem(2)))) if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & @@ -1026,25 +1039,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) ! --- integrate --- requires fully defined state array (basic + dependent state) - if (any(crystallite_todo)) then - if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then - write(6,'(/,a,i3)') '<< CRYST >> using state integrator ',numerics_integrator(numerics_integrationMode) - flush(6) - endif - select case(numerics_integrator(numerics_integrationMode)) - case(1_pInt) - call crystallite_integrateStateFPI() - case(2_pInt) - call crystallite_integrateStateEuler() - case(3_pInt) - call crystallite_integrateStateAdaptiveEuler() - case(4_pInt) - call crystallite_integrateStateRK4() - case(5_pInt) - call crystallite_integrateStateRKCK45() - end select - endif - + if (any(crystallite_todo)) call integrateState() where(.not. crystallite_converged .and. crystallite_subStep > subStepMinCryst) & ! do not try non-converged & fully cutbacked any further crystallite_todo = .true. @@ -1215,8 +1210,6 @@ end subroutine crystallite_stressAndItsTangent subroutine crystallite_integrateStateRK4() use, intrinsic :: & IEEE_arithmetic - use numerics, only: & - numerics_integrationMode use debug, only: & #ifdef DEBUG debug_e, & @@ -1517,8 +1510,7 @@ subroutine crystallite_integrateStateRKCK45() debug_levelExtensive, & debug_levelSelective use numerics, only: & - rTol_crystalliteState, & - numerics_integrationMode + rTol_crystalliteState use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -2013,8 +2005,7 @@ subroutine crystallite_integrateStateAdaptiveEuler() debug_levelExtensive, & debug_levelSelective use numerics, only: & - rTol_crystalliteState, & - numerics_integrationMode + rTol_crystalliteState use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -2082,7 +2073,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() sourceStateResiduum = 0.0_pReal relSourceStateResiduum = 0.0_pReal - integrationMode: if (numerics_integrationMode == 1_pInt) then !$OMP PARALLEL ! --- DOT STATE (EULER INTEGRATION) --- @@ -2182,7 +2172,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() enddo; enddo; enddo !$OMP ENDDO !$OMP END PARALLEL - endif integrationMode ! --- STRESS INTEGRATION (EULER INTEGRATION) --- @@ -2202,9 +2191,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() enddo; enddo; enddo !$OMP END PARALLEL DO - - if (numerics_integrationMode == 1_pInt) then - !$OMP PARALLEL ! --- DOT STATE (HEUN METHOD) --- @@ -2323,17 +2309,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() !$OMP ENDDO !$OMP END PARALLEL - elseif (numerics_integrationMode > 1) then ! stiffness calculation - - !$OMP PARALLEL DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! ... converged per definitionem - enddo; enddo; enddo - !$OMP END PARALLEL DO - - endif - - ! --- NONLOCAL CONVERGENCE CHECK --- @@ -2364,7 +2339,6 @@ subroutine crystallite_integrateStateEuler() debug_levelExtensive, & debug_levelSelective use numerics, only: & - numerics_integrationMode, & numerics_timeSyncing use FEsolving, only: & FEsolving_execElem, & @@ -2411,7 +2385,6 @@ eIter = FEsolving_execElem(1:2) singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) - if (numerics_integrationMode == 1_pInt) then !$OMP PARALLEL ! --- DOT STATE --- @@ -2516,7 +2489,6 @@ eIter = FEsolving_execElem(1:2) enddo; enddo; enddo !$OMP ENDDO !$OMP END PARALLEL - endif !$OMP PARALLEL @@ -2581,7 +2553,6 @@ subroutine crystallite_integrateStateFPI() debug_levelSelective use numerics, only: & nState, & - numerics_integrationMode, & rTol_crystalliteState use FEsolving, only: & FEsolving_execElem, & @@ -3156,7 +3127,6 @@ logical function crystallite_integrateStress(& aTol_crystalliteStress, & rTol_crystalliteStress, & iJacoLpresiduum, & - numerics_integrationMode, & subStepSizeLp, & subStepSizeLi use debug, only: debug_level, & diff --git a/src/numerics.f90 b/src/numerics.f90 index 8de664248..e73bc8321 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -27,9 +27,8 @@ module numerics worldsize = 0_pInt !< MPI worldsize (/=0 for MPI simulations only) integer(4), protected, public :: & DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive - integer(pInt), public :: & - numerics_integrationMode = 0_pInt !< integrationMode 1 = central solution; integrationMode 2 = perturbation, Default 0: undefined, is not read from file - integer(pInt), dimension(2) , protected, public :: & +!> ToDo: numerics_integrator in an array for historical reasons, only element 1 is used! + integer(pInt), dimension(2), protected, public :: & numerics_integrator = 1_pInt !< method used for state integration (central & perturbed state), Default 1: fix-point iteration for both states real(pReal), protected, public :: & relevantStrain = 1.0e-7_pReal, & !< strain increment considered significant (used by crystallite to determine whether strain inc is considered significant) @@ -317,9 +316,7 @@ subroutine numerics_init case ('atol_crystallitestress') aTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt) case ('integrator') - numerics_integrator(1) = IO_intValue(line,chunkPos,2_pInt) - case ('integratorstiffness') - numerics_integrator(2) = IO_intValue(line,chunkPos,2_pInt) + numerics_integrator = IO_intValue(line,chunkPos,2_pInt) case ('usepingpong') usepingpong = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('timesyncing') @@ -531,7 +528,7 @@ subroutine numerics_init write(6,'(a24,1x,es8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState write(6,'(a24,1x,es8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress write(6,'(a24,1x,es8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress - write(6,'(a24,2(1x,i8))') ' integrator: ',numerics_integrator + write(6,'(a24,1x,es8.1)') ' integtator: ',numerics_integrator write(6,'(a24,1x,L8)') ' timeSyncing: ',numerics_timeSyncing write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 41666a34c..e1355da8f 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -2382,8 +2382,7 @@ use, intrinsic :: & use prec, only: dNeq0, & dNeq, & dEq0 -use numerics, only: numerics_integrationMode, & - numerics_timeSyncing +use numerics, only: numerics_timeSyncing use IO, only: IO_error use debug, only: debug_level, & debug_constitutive, & @@ -2942,14 +2941,12 @@ rhoDot = rhoDotFlux & + rhoDotAthermalAnnihilation & + rhoDotThermalAnnihilation -if (numerics_integrationMode == 1_pInt) then ! save rates for output if in central integration mode - rhoDotFluxOutput(1:ns,1:8,1_pInt,ip,el) = rhoDotFlux(1:ns,1:8) - rhoDotMultiplicationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotMultiplication(1:ns,[1,3]) - rhoDotSingle2DipoleGlideOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotSingle2DipoleGlide(1:ns,9:10) - rhoDotAthermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotAthermalAnnihilation(1:ns,9:10) - rhoDotThermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotThermalAnnihilation(1:ns,9:10) - rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1) -endif +rhoDotFluxOutput(1:ns,1:8,1_pInt,ip,el) = rhoDotFlux(1:ns,1:8) +rhoDotMultiplicationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotMultiplication(1:ns,[1,3]) +rhoDotSingle2DipoleGlideOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotSingle2DipoleGlide(1:ns,9:10) +rhoDotAthermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotAthermalAnnihilation(1:ns,9:10) +rhoDotThermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotThermalAnnihilation(1:ns,9:10) +rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1) #ifdef DEBUG From 821860987c22b47be229bdb991c39987adf06d54 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 17 Aug 2018 00:14:25 +0200 Subject: [PATCH 115/208] copied existing files --- src/DAMASK_FEM.f90 | 664 ++++++++++++++++++++++++++++ src/FEM_interface.f90 | 470 ++++++++++++++++++++ src/FEM_mech.f90 | 992 ++++++++++++++++++++++++++++++++++++++++++ src/FEM_mesh.f90 | 446 +++++++++++++++++++ src/FEM_utilities.f90 | 819 ++++++++++++++++++++++++++++++++++ src/FEM_zoo.f90 | 356 +++++++++++++++ 6 files changed, 3747 insertions(+) create mode 100644 src/DAMASK_FEM.f90 create mode 100644 src/FEM_interface.f90 create mode 100755 src/FEM_mech.f90 create mode 100644 src/FEM_mesh.f90 create mode 100644 src/FEM_utilities.f90 create mode 100644 src/FEM_zoo.f90 diff --git a/src/DAMASK_FEM.f90 b/src/DAMASK_FEM.f90 new file mode 100644 index 000000000..60134f861 --- /dev/null +++ b/src/DAMASK_FEM.f90 @@ -0,0 +1,664 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Driver controlling inner and outer load case looping of the various FEM solvers +!> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing +!> results +!-------------------------------------------------------------------------------------------------- +program DAMASK_FEM +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif +#include + use PETScsys + use prec, only: & + pInt, & + pLongInt, & + pReal, & + tol_math_check, & + dNeq + use system_routines, only: & + getCWD + use DAMASK_interface, only: & + DAMASK_interface_init, & + loadCaseFile, & + geometryFile, & + getSolverJobName, & + appendToOutFile + use IO, only: & + IO_read, & + IO_isBlank, & + IO_open_file, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_error, & + IO_lc, & + IO_intOut, & + IO_warning, & + IO_timeStamp, & + IO_EOF + use debug, only: & + debug_level, & + debug_spectral, & + debug_levelBasic + use math ! need to include the whole module for FFTW + use mesh, only: & + grid, & + geomSize + use CPFEM2, only: & + CPFEM_initAll + use FEsolving, only: & + restartWrite, & + restartInc + use numerics, only: & + worldrank, & + worldsize, & + stagItMax, & + maxCutBack, & + spectral_solver, & + continueCalculation + use homogenization, only: & + materialpoint_sizeResults, & + materialpoint_results, & + materialpoint_postResults + use material, only: & + thermal_type, & + damage_type, & + THERMAL_conduction_ID, & + DAMAGE_nonlocal_ID + use FEM_utilities + use FEM_mech + + implicit none + +!-------------------------------------------------------------------------------------------------- +! variables related to information from load case and geom file + real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0) + logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors + integer(pInt), parameter :: FILEUNIT = 234_pInt !< file unit, DAMASK IO does not support newunit feature + integer(pInt), allocatable, dimension(:) :: chunkPos + + integer(pInt) :: & + N_t = 0_pInt, & !< # of time indicators found in load case file + N_n = 0_pInt, & !< # of increment specifiers found in load case file + N_def = 0_pInt !< # of rate of deformation specifiers found in load case file + character(len=65536) :: & + line + +!-------------------------------------------------------------------------------------------------- +! loop variables, convergence etc. + real(pReal), dimension(3,3), parameter :: & + ones = 1.0_pReal, & + zeros = 0.0_pReal + integer(pInt), parameter :: & + subStepFactor = 2_pInt !< for each substep, divide the last time increment by 2.0 + real(pReal) :: & + time = 0.0_pReal, & !< elapsed time + time0 = 0.0_pReal, & !< begin of interval + timeinc = 1.0_pReal, & !< current time interval + timeIncOld = 0.0_pReal, & !< previous time interval + remainingLoadCaseTime = 0.0_pReal !< remaining time of current load case + logical :: & + guess, & !< guess along former trajectory + stagIterate + integer(pInt) :: & + i, j, k, l, field, & + errorID, & + cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ + stepFraction = 0_pInt !< fraction of current time interval + integer(pInt) :: & + currentLoadcase = 0_pInt, & !< current load case + inc, & !< current increment in current load case + totalIncsCounter = 0_pInt, & !< total # of increments + convergedCounter = 0_pInt, & !< # of converged increments + notConvergedCounter = 0_pInt, & !< # of non-converged increments + resUnit = 0_pInt, & !< file unit for results writing + statUnit = 0_pInt, & !< file unit for statistics output + lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written + stagIter + character(len=6) :: loadcase_string + character(len=1024) :: & + incInfo, & !< string parsed to solution with information about current load case + workingDir + type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases + type(tSolutionState), allocatable, dimension(:) :: solres + integer(MPI_OFFSET_KIND) :: fileOffset + integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize + integer(pInt), parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742 + integer(pInt), parameter :: maxRealOut = maxByteOut/pReal + integer(pLongInt), dimension(2) :: outputIndex + integer :: ierr + + external :: & + quit + + +!-------------------------------------------------------------------------------------------------- +! init DAMASK (all modules) + call CPFEM_initAll(el = 1_pInt, ip = 1_pInt) + write(6,'(/,a)') ' <<<+- DAMASK_spectral init -+>>>' + write(6,'(/,a,/)') ' Roters et al., Computational Materials Science, 2018' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + +!-------------------------------------------------------------------------------------------------- +! initialize field solver information + nActiveFields = 1 + if (any(thermal_type == THERMAL_conduction_ID )) nActiveFields = nActiveFields + 1 + if (any(damage_type == DAMAGE_nonlocal_ID )) nActiveFields = nActiveFields + 1 + allocate(solres(nActiveFields)) + +!-------------------------------------------------------------------------------------------------- +! reading basic information from load case file and allocate data structure containing load cases + call IO_open_file(FILEUNIT,trim(loadCaseFile)) + rewind(FILEUNIT) + do + line = IO_read(FILEUNIT) + if (trim(line) == IO_EOF) exit + if (IO_isBlank(line)) cycle ! skip empty lines + chunkPos = IO_stringPos(line) + do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase + select case (IO_lc(IO_stringValue(line,chunkPos,i))) + case('l','velocitygrad','velgrad','velocitygradient','fdot','dotf','f') + N_def = N_def + 1_pInt + case('t','time','delta') + N_t = N_t + 1_pInt + case('n','incs','increments','steps','logincs','logincrements','logsteps') + N_n = N_n + 1_pInt + end select + enddo ! count all identifiers to allocate memory and do sanity check + enddo + + if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check + call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase + allocate (loadCases(N_n)) ! array of load cases + loadCases%stress%myType='stress' + + do i = 1, size(loadCases) + allocate(loadCases(i)%ID(nActiveFields)) + field = 1 + loadCases(i)%ID(field) = FIELD_MECH_ID ! mechanical active by default + thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then + field = field + 1 + loadCases(i)%ID(field) = FIELD_THERMAL_ID + endif thermalActive + damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then + field = field + 1 + loadCases(i)%ID(field) = FIELD_DAMAGE_ID + endif damageActive + enddo + +!-------------------------------------------------------------------------------------------------- +! reading the load case and assign values to the allocated data structure + rewind(FILEUNIT) + do + line = IO_read(FILEUNIT) + if (trim(line) == IO_EOF) exit + if (IO_isBlank(line)) cycle ! skip empty lines + currentLoadCase = currentLoadCase + 1_pInt + chunkPos = IO_stringPos(line) + do i = 1_pInt, chunkPos(1) + select case (IO_lc(IO_stringValue(line,chunkPos,i))) + case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f') ! assign values for the deformation BC matrix + temp_valueVector = 0.0_pReal + if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'fdot'.or. & ! in case of Fdot, set type to fdot + IO_lc(IO_stringValue(line,chunkPos,i)) == 'dotf') then + loadCases(currentLoadCase)%deformation%myType = 'fdot' + else if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'f') then + loadCases(currentLoadCase)%deformation%myType = 'f' + else + loadCases(currentLoadCase)%deformation%myType = 'l' + endif + do j = 1_pInt, 9_pInt + temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not a * + if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable + enddo + loadCases(currentLoadCase)%deformation%maskLogical = & ! logical mask in 3x3 notation + transpose(reshape(temp_maskVector,[ 3,3])) + loadCases(currentLoadCase)%deformation%maskFloat = & ! float (1.0/0.0) mask in 3x3 notation + merge(ones,zeros,loadCases(currentLoadCase)%deformation%maskLogical) + loadCases(currentLoadCase)%deformation%values = math_plain9to33(temp_valueVector) ! values in 3x3 notation + case('p','pk1','piolakirchhoff','stress', 's') + temp_valueVector = 0.0_pReal + do j = 1_pInt, 9_pInt + temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk + if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable + enddo + loadCases(currentLoadCase)%stress%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) + loadCases(currentLoadCase)%stress%maskFloat = merge(ones,zeros,& + loadCases(currentLoadCase)%stress%maskLogical) + loadCases(currentLoadCase)%stress%values = math_plain9to33(temp_valueVector) + case('t','time','delta') ! increment time + loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt) + case('n','incs','increments','steps') ! number of increments + loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) + case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling) + loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) + loadCases(currentLoadCase)%logscale = 1_pInt + case('freq','frequency','outputfreq') ! frequency of result writings + loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) + case('r','restart','restartwrite') ! frequency of writing restart information + loadCases(currentLoadCase)%restartfrequency = & + max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt)) + case('guessreset','dropguessing') + loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory + case('euler') ! rotation of currentLoadCase given in euler angles + temp_valueVector = 0.0_pReal + l = 1_pInt ! assuming values given in degrees + k = 1_pInt ! assuming keyword indicating degree/radians present + select case (IO_lc(IO_stringValue(line,chunkPos,i+1_pInt))) + case('deg','degree') + case('rad','radian') ! don't convert from degree to radian + l = 0_pInt + case default + k = 0_pInt + end select + do j = 1_pInt, 3_pInt + temp_valueVector(j) = IO_floatValue(line,chunkPos,i+k+j) + enddo + if (l == 1_pInt) temp_valueVector(1:3) = temp_valueVector(1:3) * inRad ! convert to rad + loadCases(currentLoadCase)%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix + case('rotation','rot') ! assign values for the rotation of currentLoadCase matrix + temp_valueVector = 0.0_pReal + do j = 1_pInt, 9_pInt + temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) + enddo + loadCases(currentLoadCase)%rotation = math_plain9to33(temp_valueVector) + end select + enddo; enddo + close(FILEUNIT) + +!-------------------------------------------------------------------------------------------------- +! consistency checks and output of load case + loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase + errorID = 0_pInt + if (worldrank == 0) then + checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases) + write (loadcase_string, '(i6)' ) currentLoadCase + write(6,'(1x,a,i6)') 'load case: ', currentLoadCase + if (.not. loadCases(currentLoadCase)%followFormerTrajectory) & + write(6,'(2x,a)') 'drop guessing along trajectory' + if (loadCases(currentLoadCase)%deformation%myType == 'l') then + do j = 1_pInt, 3_pInt + if (any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .true.) .and. & + any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .false.)) & + errorID = 832_pInt ! each row should be either fully or not at all defined + enddo + write(6,'(2x,a)') 'velocity gradient:' + else if (loadCases(currentLoadCase)%deformation%myType == 'f') then + write(6,'(2x,a)') 'deformation gradient at end of load case:' + else + write(6,'(2x,a)') 'deformation gradient rate:' + endif + do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt + if(loadCases(currentLoadCase)%deformation%maskLogical(i,j)) then + write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%deformation%values(i,j) + else + write(6,'(2x,12a)',advance='no') ' * ' + endif + enddo; write(6,'(/)',advance='no') + enddo + if (any(loadCases(currentLoadCase)%stress%maskLogical .eqv. & + loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only + if (any(loadCases(currentLoadCase)%stress%maskLogical .and. & + transpose(loadCases(currentLoadCase)%stress%maskLogical) .and. & + reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) & + errorID = 838_pInt ! no rotation is allowed by stress BC + write(6,'(2x,a)') 'stress / GPa:' + do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt + if(loadCases(currentLoadCase)%stress%maskLogical(i,j)) then + write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%stress%values(i,j)*1e-9_pReal + else + write(6,'(2x,12a)',advance='no') ' * ' + endif + enddo; write(6,'(/)',advance='no') + enddo + if (any(abs(math_mul33x33(loadCases(currentLoadCase)%rotation, & + math_transpose33(loadCases(currentLoadCase)%rotation))-math_I3) > & + reshape(spread(tol_math_check,1,9),[ 3,3]))& + .or. abs(math_det33(loadCases(currentLoadCase)%rotation)) > & + 1.0_pReal + tol_math_check) errorID = 846_pInt ! given rotation matrix contains strain + if (any(dNeq(loadCases(currentLoadCase)%rotation, math_I3))) & + write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',& + math_transpose33(loadCases(currentLoadCase)%rotation) + if (loadCases(currentLoadCase)%time < 0.0_pReal) errorID = 834_pInt ! negative time increment + write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time + if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count + write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs + if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency + write(6,'(2x,a,i5)') 'output frequency: ', & + loadCases(currentLoadCase)%outputfrequency + write(6,'(2x,a,i5,/)') 'restart frequency: ', & + loadCases(currentLoadCase)%restartfrequency + if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message + enddo checkLoadcases + endif + +!-------------------------------------------------------------------------------------------------- +! doing initialization depending on selected solver + call Utilities_init() + do field = 1, nActiveFields + select case (loadCases(1)%ID(field)) + case(FIELD_MECH_ID) + select case (spectral_solver) + case (DAMASK_spectral_SolverBasic_label) + call basic_init + + case (DAMASK_spectral_SolverPolarisation_label) + if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & + call IO_warning(42_pInt, ext_msg='debug Divergence') + call Polarisation_init + + case default + call IO_error(error_ID = 891_pInt, ext_msg = trim(spectral_solver)) + + end select + + case(FIELD_THERMAL_ID) + call spectral_thermal_init + + case(FIELD_DAMAGE_ID) + call spectral_damage_init() + + end select + enddo + +!-------------------------------------------------------------------------------------------------- +! write header of output file + if (worldrank == 0) then + if (.not. appendToOutFile) then ! after restart, append to existing results file + if (getCWD(workingDir)) call IO_error(106_pInt,ext_msg=trim(workingDir)) + open(newunit=resUnit,file=trim(getSolverJobName())//& + '.spectralOut',form='UNFORMATTED',status='REPLACE') + write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header + write(resUnit) 'workingdir:', trim(workingDir) + write(resUnit) 'geometry:', trim(geometryFile) + write(resUnit) 'grid:', grid + write(resUnit) 'size:', geomSize + write(resUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults + write(resUnit) 'loadcases:', size(loadCases) + write(resUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase + write(resUnit) 'times:', loadCases%time ! one entry per LoadCase + write(resUnit) 'logscales:', loadCases%logscale + write(resUnit) 'increments:', loadCases%incs ! one entry per LoadCase + write(resUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc + write(resUnit) 'eoh' + close(resUnit) ! end of header + open(newunit=statUnit,file=trim(getSolverJobName())//& + '.sta',form='FORMATTED',status='REPLACE') + write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file + if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) & + write(6,'(/,a)') ' header of result and statistics file written out' + flush(6) + else ! open new files ... + open(newunit=statUnit,file=trim(getSolverJobName())//& + '.sta',form='FORMATTED', position='APPEND', status='OLD') + endif + endif + +!-------------------------------------------------------------------------------------------------- +! looping over loadcases + loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) + time0 = time ! currentLoadCase start time + guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc + +!-------------------------------------------------------------------------------------------------- +! loop over incs defined in input file for current currentLoadCase + incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs + totalIncsCounter = totalIncsCounter + 1_pInt + +!-------------------------------------------------------------------------------------------------- +! forwarding time + timeIncOld = timeinc ! last timeinc that brought former inc to an end + if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale + timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal) + else + if (currentLoadCase == 1_pInt) then ! 1st currentLoadCase of logarithmic scale + if (inc == 1_pInt) then ! 1st inc of 1st currentLoadCase of logarithmic scale + timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd + else ! not-1st inc of 1st currentLoadCase of logarithmic scale + timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal)) + endif + else ! not-1st currentLoadCase of logarithmic scale + timeinc = time0 * & + ( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc ,pReal)/& + real(loadCases(currentLoadCase)%incs ,pReal))& + -(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1_pInt ,pReal)/& + real(loadCases(currentLoadCase)%incs ,pReal))) + endif + endif + timeinc = timeinc * real(subStepFactor,pReal)**real(-cutBackLevel,pReal) ! depending on cut back level, decrease time step + + skipping: if (totalIncsCounter <= restartInc) then ! not yet at restart inc? + time = time + timeinc ! just advance time, skip already performed calculation + guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference + else skipping + stepFraction = 0_pInt ! fraction scaled by stepFactor**cutLevel + +!-------------------------------------------------------------------------------------------------- +! loop over sub step + subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel) + remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time + time = time + timeinc ! forward target time + stepFraction = stepFraction + 1_pInt ! count step + +!-------------------------------------------------------------------------------------------------- +! report begin of new step + write(6,'(/,a)') ' ###########################################################################' + write(6,'(1x,a,es12.5'//& + ',a,'//IO_intOut(inc) //',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//& + ',a,'//IO_intOut(stepFraction) //',a,'//IO_intOut(subStepFactor**cutBackLevel)//& + ',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') & + 'Time', time, & + 's: Increment ', inc,'/',loadCases(currentLoadCase)%incs,& + '-', stepFraction,'/',subStepFactor**cutBackLevel,& + ' of load case ', currentLoadCase,'/',size(loadCases) + write(incInfo,& + '(a,'//IO_intOut(totalIncsCounter)//& + ',a,'//IO_intOut(sum(loadCases%incs))//& + ',a,'//IO_intOut(stepFraction)//& + ',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') & + 'Increment ',totalIncsCounter,'/',sum(loadCases%incs),& + '-', stepFraction,'/',subStepFactor**cutBackLevel + flush(6) + +!-------------------------------------------------------------------------------------------------- +! forward fields + do field = 1, nActiveFields + select case(loadCases(currentLoadCase)%ID(field)) + case(FIELD_MECH_ID) + select case (spectral_solver) + case (DAMASK_spectral_SolverBasic_label) + call Basic_forward (& + guess,timeinc,timeIncOld,remainingLoadCaseTime, & + deformation_BC = loadCases(currentLoadCase)%deformation, & + stress_BC = loadCases(currentLoadCase)%stress, & + rotation_BC = loadCases(currentLoadCase)%rotation) + + case (DAMASK_spectral_SolverPolarisation_label) + call Polarisation_forward (& + guess,timeinc,timeIncOld,remainingLoadCaseTime, & + deformation_BC = loadCases(currentLoadCase)%deformation, & + stress_BC = loadCases(currentLoadCase)%stress, & + rotation_BC = loadCases(currentLoadCase)%rotation) + end select + + case(FIELD_THERMAL_ID); call spectral_thermal_forward() + case(FIELD_DAMAGE_ID); call spectral_damage_forward() + end select + enddo + +!-------------------------------------------------------------------------------------------------- +! solve fields + stagIter = 0_pInt + stagIterate = .true. + do while (stagIterate) + do field = 1, nActiveFields + select case(loadCases(currentLoadCase)%ID(field)) + case(FIELD_MECH_ID) + select case (spectral_solver) + case (DAMASK_spectral_SolverBasic_label) + solres(field) = Basic_solution (& + incInfo,timeinc,timeIncOld, & + stress_BC = loadCases(currentLoadCase)%stress, & + rotation_BC = loadCases(currentLoadCase)%rotation) + + case (DAMASK_spectral_SolverPolarisation_label) + solres(field) = Polarisation_solution (& + incInfo,timeinc,timeIncOld, & + stress_BC = loadCases(currentLoadCase)%stress, & + rotation_BC = loadCases(currentLoadCase)%rotation) + + end select + + case(FIELD_THERMAL_ID) + solres(field) = spectral_thermal_solution(timeinc,timeIncOld,remainingLoadCaseTime) + + case(FIELD_DAMAGE_ID) + solres(field) = spectral_damage_solution(timeinc,timeIncOld,remainingLoadCaseTime) + + end select + + if (.not. solres(field)%converged) exit ! no solution found + + enddo + stagIter = stagIter + 1_pInt + stagIterate = stagIter < stagItMax & + .and. all(solres(:)%converged) & + .and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration + enddo + +!-------------------------------------------------------------------------------------------------- +! check solution for either advance or retry + + if ( (continueCalculation .or. all(solres(:)%converged .and. solres(:)%stagConverged)) & ! don't care or did converge + .and. .not. solres(1)%termIll) then ! and acceptable solution found + timeIncOld = timeinc + cutBack = .false. + guess = .true. ! start guessing after first converged (sub)inc + if (worldrank == 0) then + write(statUnit,*) totalIncsCounter, time, cutBackLevel, & + solres%converged, solres%iterationsNeeded + flush(statUnit) + endif + elseif (cutBackLevel < maxCutBack) then ! further cutbacking tolerated? + cutBack = .true. + stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator + cutBackLevel = cutBackLevel + 1_pInt + time = time - timeinc ! rewind time + timeinc = timeinc/real(subStepFactor,pReal) ! cut timestep + write(6,'(/,a)') ' cutting back ' + else ! no more options to continue + call IO_warning(850_pInt) + call MPI_file_close(resUnit,ierr) + close(statUnit) + call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written + endif + + enddo subStepLooping + + cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc + + if (all(solres(:)%converged)) then + convergedCounter = convergedCounter + 1_pInt + write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc + ' increment ', totalIncsCounter, ' converged' + else + notConvergedCounter = notConvergedCounter + 1_pInt + write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc + ' increment ', totalIncsCounter, ' NOT converged' + endif; flush(6) + + if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency + write(6,'(1/,a)') ' ... writing results to file ......................................' + flush(6) + call materialpoint_postResults() + endif + if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ... + .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information + restartWrite = .true. ! set restart parameter for FEsolving + lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write? + endif + + endif skipping + + enddo incLooping + + enddo loadCaseLooping + + +!-------------------------------------------------------------------------------------------------- +! report summary of whole calculation + write(6,'(/,a)') ' ###########################################################################' + write(6,'(1x,'//IO_intOut(convergedCounter)//',a,'//IO_intOut(notConvergedCounter + convergedCounter)//',a,f5.1,a)') & + convergedCounter, ' out of ', & + notConvergedCounter + convergedCounter, ' (', & + real(convergedCounter, pReal)/& + real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, & + ' %) increments converged!' + flush(6) + call MPI_file_close(resUnit,ierr) + close(statUnit) + + if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged + call quit(0_pInt) ! no complains ;) + +end program DAMASK_FEM + + +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief quit subroutine to mimic behavior of FEM solvers +!> @details exits the Spectral solver and reports time and duration. Exit code 0 signals +!> everything went fine. Exit code 1 signals an error, message according to IO_error. Exit code +!> 2 signals no converged solution and increment of last saved restart information is written to +!> stderr. Exit code 3 signals no severe problems, but some increments did not converge +!-------------------------------------------------------------------------------------------------- +subroutine quit(stop_id) +#include + use MPI + use prec, only: & + pInt + + implicit none + integer(pInt), intent(in) :: stop_id + integer, dimension(8) :: dateAndTime ! type default integer + integer(pInt) :: error = 0_pInt + PetscErrorCode :: ierr = 0 + logical :: ErrorInQuit + + external :: & + PETScFinalize + + call PETScFinalize(ierr) + if (ierr /= 0) write(6,'(a)') ' Error in PETScFinalize' +#ifdef _OPENMP + call MPI_finalize(error) + if (error /= 0) write(6,'(a)') ' Error in MPI_finalize' +#endif + ErrorInQuit = (ierr /= 0 .or. error /= 0_pInt) + + call date_and_time(values = dateAndTime) + write(6,'(/,a)') 'DAMASK terminated on:' + write(6,'(a,2(i2.2,a),i4.4)') 'Date: ',dateAndTime(3),'/',& + dateAndTime(2),'/',& + dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') 'Time: ',dateAndTime(5),':',& + dateAndTime(6),':',& + dateAndTime(7) + + if (stop_id == 0_pInt .and. .not. ErrorInQuit) stop 0 ! normal termination + if (stop_id < 0_pInt .and. .not. ErrorInQuit) then ! terminally ill, restart might help + write(0,'(a,i6)') 'restart information available at ', stop_id*(-1_pInt) + stop 2 + endif + if (stop_id == 3_pInt .and. .not. ErrorInQuit) stop 3 ! not all incs converged + + stop 1 ! error (message from IO_error) + +end subroutine quit diff --git a/src/FEM_interface.f90 b/src/FEM_interface.f90 new file mode 100644 index 000000000..4a369dd9c --- /dev/null +++ b/src/FEM_interface.f90 @@ -0,0 +1,470 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Interfacing between the FEM solvers and the material subroutines provided +!! by DAMASK +!> @details Interfacing between the FEM solvers and the material subroutines provided +!> by DAMASK. Interpretating the command line arguments to the init routine to +!> get load case, geometry file, working directory, etc. +!-------------------------------------------------------------------------------------------------- +module DAMASK_interface + use prec, only: & + pInt + + implicit none + private + logical, public, protected :: appendToOutFile = .false. !< Append to existing output file + integer(pInt), public, protected :: FEMRestartInc = 0_pInt !< Increment at which calculation starts + character(len=1024), public, protected :: & + geometryFile = '', & !< parameter given for geometry file + loadCaseFile = '' !< parameter given for load case file + character(len=1024), private :: workingDirectory + + public :: & + getSolverJobName, & + DAMASK_interface_init + private :: & + setWorkingDirectory, & + getGeometryFile, & + getLoadCaseFile, & + rectifyPath, & + makeRelativePath, & + IIO_stringValue, & + IIO_intValue, & + IIO_stringPos +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes the solver by interpreting the command line arguments. Also writes +!! information on computation to screen +!-------------------------------------------------------------------------------------------------- +subroutine DAMASK_interface_init() + use, intrinsic :: & + iso_fortran_env +#include +#if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINOR!=9 +=================================================================================================== +========================= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ========================= +=================================================================================================== +#endif + use PETScSys + use system_routines, only: & + getHostName + + implicit none + character(len=1024) :: & + commandLine, & !< command line call as string + loadcaseArg = '', & !< -l argument given to DAMASK_FEM.exe + geometryArg = '', & !< -g argument given to DAMASK_FEM.exe + workingDirArg = '', & !< -w argument given to DAMASK_FEM.exe + hostName, & !< name of machine on which DAMASK_FEM.exe is execute (might require export HOSTNAME) + userName, & !< name of user calling DAMASK_FEM.exe + tag + integer :: & + i, & +#ifdef _OPENMP + threadLevel, & +#endif + worldrank = 0, & + worldsize = 0 + integer, allocatable, dimension(:) :: & + chunkPos + integer, dimension(8) :: & + dateAndTime ! type default integer + PetscErrorCode :: ierr + logical :: error + external :: & + quit,& + PETScErrorF, & ! is called in the CHKERRQ macro + PETScInitialize + + open(6, encoding='UTF-8') ! for special characters in output + +!-------------------------------------------------------------------------------------------------- +! PETSc Init +#ifdef _OPENMP + ! If openMP is enabled, check if the MPI libary supports it and initialize accordingly. + ! Otherwise, the first call to PETSc will do the initialization. + call MPI_Init_Thread(MPI_THREAD_FUNNELED,threadLevel,ierr);CHKERRQ(ierr) + if (threadLevel>>' + write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018' + write(6,'(/,a)') ' Version: '//DAMASKVERSION + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& + dateAndTime(2),'/',& + dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& + dateAndTime(6),':',& + dateAndTime(7) + write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize + write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' +#include "compilation_info.f90" + + call get_command(commandLine) + chunkPos = IIO_stringPos(commandLine) + do i = 2_pInt, chunkPos(1) + select case(IIO_stringValue(commandLine,chunkPos,i)) ! extract key + case ('-h','--help') + write(6,'(a)') ' #######################################################################' + write(6,'(a)') ' DAMASK_FEM:' + write(6,'(a)') ' FEM solvers for the Düsseldorf Advanced Material Simulation Kit' + write(6,'(a,/)')' #######################################################################' + write(6,'(a,/)')' Valid command line switches:' + write(6,'(a)') ' --geom (-g, --geometry)' + write(6,'(a)') ' --load (-l, --loadcase)' + write(6,'(a)') ' --workingdir (-w, --wd, --workingdirectory, -d, --directory)' + write(6,'(a)') ' --restart (-r, --rs)' + write(6,'(a)') ' --help (-h)' + write(6,'(/,a)')' -----------------------------------------------------------------------' + write(6,'(a)') ' Mandatory arguments:' + write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom.geom' + write(6,'(a)') ' Specifies the location of the geometry definition file,' + write(6,'(a)') ' if no extension is given, .geom will be appended.' + write(6,'(a)') ' "PathToGeomFile" will be the working directory if not specified' + write(6,'(a)') ' via --workingdir.' + write(6,'(a)') ' Make sure the file "material.config" exists in the working' + write(6,'(a)') ' directory.' + write(6,'(a)') ' For further configuration place "numerics.config"' + write(6,'(a)')' and "numerics.config" in that directory.' + write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile.load' + write(6,'(a)') ' Specifies the location of the load case definition file,' + write(6,'(a)') ' if no extension is given, .load will be appended.' + write(6,'(/,a)')' -----------------------------------------------------------------------' + write(6,'(a)') ' Optional arguments:' + write(6,'(/,a)')' --workingdirectory PathToWorkingDirectory' + write(6,'(a)') ' Specifies the working directory and overwrites the default' + write(6,'(a)') ' "PathToGeomFile".' + write(6,'(a)') ' Make sure the file "material.config" exists in the working' + write(6,'(a)') ' directory.' + write(6,'(a)') ' For further configuration place "numerics.config"' + write(6,'(a)')' and "debug.config" in that directory.' + write(6,'(/,a)')' --restart XX' + write(6,'(a)') ' Reads in increment XX and continues with calculating' + write(6,'(a)') ' increment XX+1 based on this.' + write(6,'(a)') ' Appends to existing results file' + write(6,'(a)') ' "NameOfGeom_NameOfLoadFile.YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY".' + write(6,'(a)') ' Works only if the restart information for increment XX' + write(6,'(a)') ' is available in the working directory.' + write(6,'(/,a)')' -----------------------------------------------------------------------' + write(6,'(a)') ' Help:' + write(6,'(/,a)')' --help' + write(6,'(a,/)')' Prints this message and exits' + call quit(0_pInt) ! normal Termination + case ('-l', '--load', '--loadcase') + if ( i < chunkPos(1)) loadcaseArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) + case ('-g', '--geom', '--geometry') + if (i < chunkPos(1)) geometryArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) + case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory') + if (i < chunkPos(1)) workingDirArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) + case ('-r', '--rs', '--restart') + if (i < chunkPos(1)) then + FEMRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) + appendToOutFile = .true. + endif + end select + enddo + + if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0) then + write(6,'(a)') ' Please specify geometry AND load case (-h for help)' + call quit(1_pInt) + endif + + workingDirectory = trim(setWorkingDirectory(trim(workingDirArg))) + geometryFile = getGeometryFile(geometryArg) + loadCaseFile = getLoadCaseFile(loadCaseArg) + + call get_environment_variable('USER',userName) + error = getHostName(hostName) + write(6,'(a,a)') ' Host name: ', trim(hostName) + write(6,'(a,a)') ' User name: ', trim(userName) + write(6,'(a,a)') ' Command line call: ', trim(commandLine) + if (len(trim(workingDirArg)) > 0) & + write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) + write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) + write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg) + write(6,'(a,a)') ' Working directory: ', trim(workingDirectory) + write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) + write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) + write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) + if (SpectralRestartInc > 0_pInt) & + write(6,'(a,i6.6)') ' Restart from increment: ', FEMRestartInc + write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile + +end subroutine DAMASK_interface_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief extract working directory from given argument or from location of geometry file, +!! possibly converting relative arguments to absolut path +!-------------------------------------------------------------------------------------------------- +character(len=1024) function setWorkingDirectory(workingDirectoryArg) + use system_routines, only: & + getCWD, & + setCWD + + implicit none + character(len=*), intent(in) :: workingDirectoryArg !< working directory argument + logical :: error + external :: quit + + wdGiven: if (len(workingDirectoryArg)>0) then + absolutePath: if (workingDirectoryArg(1:1) == '/') then + setWorkingDirectory = workingDirectoryArg + else absolutePath + error = getCWD(setWorkingDirectory) + if (error) call quit(1_pInt) + setWorkingDirectory = trim(setWorkingDirectory)//'/'//workingDirectoryArg + endif absolutePath + else wdGiven + error = getCWD(setWorkingDirectory) ! relative path given as command line argument + if (error) call quit(1_pInt) + endif wdGiven + + setWorkingDirectory = trim(rectifyPath(setWorkingDirectory)) + + error = setCWD(trim(setWorkingDirectory)) + if(error) then + write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist' + call quit(1_pInt) + endif + +end function setWorkingDirectory + + +!-------------------------------------------------------------------------------------------------- +!> @brief solver job name (no extension) as combination of geometry and load case name +!-------------------------------------------------------------------------------------------------- +character(len=1024) function getSolverJobName() + + implicit none + integer :: posExt,posSep + character(len=1024) :: tempString + + + tempString = geometryFile + posExt = scan(tempString,'.',back=.true.) + posSep = scan(tempString,'/',back=.true.) + + getSolverJobName = tempString(posSep+1:posExt-1) + + tempString = loadCaseFile + posExt = scan(tempString,'.',back=.true.) + posSep = scan(tempString,'/',back=.true.) + + getSolverJobName = trim(getSolverJobName)//'_'//tempString(posSep+1:posExt-1) + +end function getSolverJobName + + +!-------------------------------------------------------------------------------------------------- +!> @brief basename of geometry file with extension from command line arguments +!-------------------------------------------------------------------------------------------------- +character(len=1024) function getGeometryFile(geometryParameter) + + implicit none + character(len=1024), intent(in) :: & + geometryParameter + integer :: posExt, posSep + external :: quit + + getGeometryFile = trim(geometryParameter) + posExt = scan(getGeometryFile,'.',back=.true.) + posSep = scan(getGeometryFile,'/',back=.true.) + + if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') + if (scan(getGeometryFile,'/') /= 1) & + getGeometryFile = trim(workingDirectory)//'/'//trim(getGeometryFile) + + getGeometryFile = makeRelativePath(workingDirectory, getGeometryFile) + + +end function getGeometryFile + + +!-------------------------------------------------------------------------------------------------- +!> @brief relative path of loadcase from command line arguments +!-------------------------------------------------------------------------------------------------- +character(len=1024) function getLoadCaseFile(loadCaseParameter) + + implicit none + character(len=1024), intent(in) :: & + loadCaseParameter + integer :: posExt, posSep + external :: quit + + getLoadCaseFile = trim(loadCaseParameter) + posExt = scan(getLoadCaseFile,'.',back=.true.) + posSep = scan(getLoadCaseFile,'/',back=.true.) + + if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') + if (scan(getLoadCaseFile,'/') /= 1) & + getLoadCaseFile = trim(workingDirectory)//'/'//trim(getLoadCaseFile) + + getLoadCaseFile = makeRelativePath(workingDirectory, getLoadCaseFile) + +end function getLoadCaseFile + + +!-------------------------------------------------------------------------------------------------- +!> @brief remove ../, /./, and // from path. +!> @details works only if absolute path is given +!-------------------------------------------------------------------------------------------------- +function rectifyPath(path) + + implicit none + character(len=*) :: path + character(len=len_trim(path)) :: rectifyPath + integer :: i,j,k,l ! no pInt + +!-------------------------------------------------------------------------------------------------- +! remove /./ from path + l = len_trim(path) + rectifyPath = path + do i = l,3,-1 + if (rectifyPath(i-2:i) == '/./') rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' + enddo + +!-------------------------------------------------------------------------------------------------- +! remove // from path + l = len_trim(path) + rectifyPath = path + do i = l,2,-1 + if (rectifyPath(i-1:i) == '//') rectifyPath(i-1:l) = rectifyPath(i:l)//' ' + enddo + +!-------------------------------------------------------------------------------------------------- +! remove ../ and corresponding directory from rectifyPath + l = len_trim(rectifyPath) + i = index(rectifyPath(i:l),'../') + j = 0 + do while (i > j) + j = scan(rectifyPath(1:i-2),'/',back=.true.) + rectifyPath(j+1:l) = rectifyPath(i+3:l)//repeat(' ',2+i-j) + if (rectifyPath(j+1:j+1) == '/') then !search for '//' that appear in case of XXX/../../XXX + k = len_trim(rectifyPath) + rectifyPath(j+1:k-1) = rectifyPath(j+2:k) + rectifyPath(k:k) = ' ' + endif + i = j+index(rectifyPath(j+1:l),'../') + enddo + if(len_trim(rectifyPath) == 0) rectifyPath = '/' + +end function rectifyPath + + +!-------------------------------------------------------------------------------------------------- +!> @brief relative path from absolute a to absolute b +!-------------------------------------------------------------------------------------------------- +character(len=1024) function makeRelativePath(a,b) + + implicit none + character (len=*), intent(in) :: a,b + character (len=1024) :: a_cleaned,b_cleaned + integer :: i,posLastCommonSlash,remainingSlashes !no pInt + + posLastCommonSlash = 0 + remainingSlashes = 0 + a_cleaned = rectifyPath(trim(a)//'/') + b_cleaned = rectifyPath(b) + + do i = 1, min(1024,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 + do i = posLastCommonSlash+1,len_trim(a_cleaned) + if (a_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1 + enddo + + makeRelativePath = repeat('..'//'/',remainingSlashes)//b_cleaned(posLastCommonSlash+1:len_trim(b_cleaned)) + +end function makeRelativePath + + +!-------------------------------------------------------------------------------------------------- +!> @brief taken from IO, check IO_stringValue for documentation +!-------------------------------------------------------------------------------------------------- +pure function IIO_stringValue(string,chunkPos,myChunk) + + implicit none + integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + integer(pInt), intent(in) :: myChunk !< position number of desired chunk + character(len=chunkPos(myChunk*2+1)-chunkPos(myChunk*2)+1) :: IIO_stringValue + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + + IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) + +end function IIO_stringValue + + +!-------------------------------------------------------------------------------------------------- +!> @brief taken from IO, check IO_intValue for documentation +!-------------------------------------------------------------------------------------------------- +integer(pInt) pure function IIO_intValue(string,chunkPos,myChunk) + + implicit none + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + integer(pInt), intent(in) :: myChunk !< position number of desired sub string + integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + + + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then + IIO_intValue = 0_pInt + else valuePresent + read(UNIT=string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)),ERR=100,FMT=*) IIO_intValue + endif valuePresent + return +100 IIO_intValue = huge(1_pInt) + +end function IIO_intValue + + +!-------------------------------------------------------------------------------------------------- +!> @brief taken from IO, check IO_stringPos for documentation +!-------------------------------------------------------------------------------------------------- +pure function IIO_stringPos(string) + + implicit none + integer(pInt), dimension(:), allocatable :: IIO_stringPos + character(len=*), intent(in) :: string !< string in which chunks are searched for + + character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces + integer :: left, right ! no pInt (verify and scan return default integer) + + allocate(IIO_stringPos(1), source=0_pInt) + right = 0 + + do while (verify(string(right+1:),SEP)>0) + left = right + verify(string(right+1:),SEP) + right = left + scan(string(left:),SEP) - 2 + if ( string(left:left) == '#' ) exit + IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)] + IIO_stringPos(1) = IIO_stringPos(1)+1_pInt + enddo + +end function IIO_stringPos + +end module diff --git a/src/FEM_mech.f90 b/src/FEM_mech.f90 new file mode 100755 index 000000000..aa967bec5 --- /dev/null +++ b/src/FEM_mech.f90 @@ -0,0 +1,992 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief FEM PETSc solver +!-------------------------------------------------------------------------------------------------- +module FEM_mech + use prec, only: & + pInt, & + pReal + use math, only: & + math_I3 + use FEM_utilities, only: & + tSolutionState, & + tFieldBC, & + tComponentBC + use numerics, only: & + worldrank, & + worldsize + use mesh, only: & + mesh_Nboundaries, & + mesh_boundaries + + implicit none + private +#include + +!-------------------------------------------------------------------------------------------------- +! derived types + type tSolutionParams + type(tFieldBC) :: fieldBC + real(pReal) :: timeinc + real(pReal) :: timeincOld + end type tSolutionParams + + type(tSolutionParams), private :: params + +!-------------------------------------------------------------------------------------------------- +! PETSc data + SNES, private :: mech_snes + Vec, private :: solution, solution_rate, solution_local + PetscInt, private :: dimPlex, cellDof, nQuadrature, nBasis + PetscReal, allocatable, target, private :: qPoints(:), qWeights(:) + MatNullSpace, private :: matnull + +!-------------------------------------------------------------------------------------------------- +! stress, stiffness and compliance average etc. + character(len=1024), private :: incInfo + real(pReal), private, dimension(3,3) :: & + P_av = 0.0_pReal + logical, private :: ForwardData + real(pReal), parameter, private :: eps = 1.0e-18_pReal + + public :: & + FEM_mech_init, & + FEM_mech_solution ,& + FEM_mech_forward, & + FEM_mech_output, & + FEM_mech_destroy + + external :: & + MPI_abort, & + MPI_Allreduce, & + VecCopy, & + VecSet, & + VecISSet, & + VecScale, & + VecWAXPY, & + VecAXPY, & + VecGetSize, & + VecAssemblyBegin, & + VecAssemblyEnd, & + VecView, & + VecDestroy, & + MatSetOption, & + MatSetLocalToGlobalMapping, & + MatSetNearNullSpace, & + MatZeroEntries, & + MatZeroRowsColumnsLocalIS, & + MatAssemblyBegin, & + MatAssemblyEnd, & + MatScale, & + MatNullSpaceCreateRigidBody, & + PetscQuadratureCreate, & + PetscFECreateDefault, & + PetscFESetQuadrature, & + PetscFEGetDimension, & + PetscFEDestroy, & + PetscFEGetDualSpace, & + PetscQuadratureDestroy, & + PetscDSSetDiscretization, & + PetscDSGetTotalDimension, & + PetscDSGetDiscretization, & + PetscDualSpaceGetFunctional, & + DMClone, & + DMCreateGlobalVector, & + DMGetDS, & + DMGetDimension, & + DMGetDefaultSection, & + DMGetDefaultGlobalSection, & + DMGetLocalToGlobalMapping, & + DMGetLocalVector, & + DMGetLabelSize, & + DMPlexCopyCoordinates, & + DMPlexGetHeightStratum, & + DMPlexGetDepthStratum, & + DMLocalToGlobalBegin, & + DMLocalToGlobalEnd, & + DMGlobalToLocalBegin, & + DMGlobalToLocalEnd, & + DMRestoreLocalVector, & + DMSNESSetFunctionLocal, & + DMSNESSetJacobianLocal, & + SNESCreate, & + SNESSetOptionsPrefix, & + SNESSetDM, & + SNESSetMaxLinearSolveFailures, & + SNESSetConvergenceTest, & + SNESSetTolerances, & + SNESSetFromOptions, & + SNESGetDM, & + SNESGetConvergedReason, & + SNESGetIterationNumber, & + SNESSolve, & + SNESDestroy, & + PetscViewerHDF5PushGroup, & + PetscViewerHDF5PopGroup, & + PetscObjectSetName + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates all neccessary fields and fills them with data, potentially from restart info +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_init(fieldBC) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) + use IO, only: & + IO_timeStamp, & + IO_error + use DAMASK_interface, only: & + getSolverJobName + use mesh, only: & + geomMesh + use numerics, only: & + worldrank, & + itmax, & + integrationOrder + use FEM_Zoo, only: & + FEM_Zoo_nQuadrature, & + FEM_Zoo_QuadraturePoints, & + FEM_Zoo_QuadratureWeights + + implicit none + type(tFieldBC), intent(in) :: fieldBC + DM :: mech_mesh + PetscFE :: mechFE + PetscQuadrature :: mechQuad, functional + PetscDS :: mechDS + PetscDualSpace :: mechDualSpace + DMLabel :: BCLabel + PetscInt, allocatable, target :: numComp(:), numDoF(:), bcField(:) + PetscInt, pointer :: pNumComp(:), pNumDof(:), pBcField(:), pBcPoint(:) + PetscInt :: numBC, bcSize + IS :: bcPoint + IS, allocatable, target :: bcComps(:), bcPoints(:) + IS, pointer :: pBcComps(:), pBcPoints(:) + PetscSection :: section + PetscInt :: field, faceSet, topologDim, nNodalPoints + PetscReal, pointer :: qPointsP(:), qWeightsP(:), & + nodalPointsP(:), nodalWeightsP(:) + PetscReal, allocatable, target :: nodalPoints(:), nodalWeights(:) + PetscScalar, pointer :: px_scal(:) + PetscScalar, allocatable, target :: x_scal(:) + PetscReal :: detJ + PetscReal, allocatable, target :: v0(:), cellJ(:), invcellJ(:), cellJMat(:,:) + PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) + PetscInt :: cellStart, cellEnd, cell, basis + character(len=7) :: prefix = 'mechFE_' + PetscErrorCode :: ierr + + if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- FEM_mech init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif + +!-------------------------------------------------------------------------------------------------- +! Setup FEM mech mesh + call DMClone(geomMesh,mech_mesh,ierr); CHKERRQ(ierr) + call DMGetDimension(mech_mesh,dimPlex,ierr); CHKERRQ(ierr) + +!-------------------------------------------------------------------------------------------------- +! Setup FEM mech discretization + allocate(qPoints(dimPlex*FEM_Zoo_nQuadrature(dimPlex,integrationOrder))) + allocate(qWeights(FEM_Zoo_nQuadrature(dimPlex,integrationOrder))) + qPoints = FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p + qWeights = FEM_Zoo_QuadratureWeights(dimPlex,integrationOrder)%p + nQuadrature = FEM_Zoo_nQuadrature(dimPlex,integrationOrder) + qPointsP => qPoints + qWeightsP => qWeights + call PetscQuadratureCreate(PETSC_COMM_SELF,mechQuad,ierr); CHKERRQ(ierr) + call PetscQuadratureSetData(mechQuad,dimPlex,nQuadrature,qPointsP,qWeightsP,ierr) + CHKERRQ(ierr) + call PetscFECreateDefault(mech_mesh,dimPlex,dimPlex,PETSC_TRUE,prefix, & + integrationOrder,mechFE,ierr); CHKERRQ(ierr) + call PetscFESetQuadrature(mechFE,mechQuad,ierr); CHKERRQ(ierr) + call PetscFEGetDimension(mechFE,nBasis,ierr); CHKERRQ(ierr) + call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr) + call PetscDSAddDiscretization(mechDS,mechFE,ierr); CHKERRQ(ierr) + call PetscDSGetTotalDimension(mechDS,cellDof,ierr); CHKERRQ(ierr) + call PetscFEDestroy(mechFE,ierr); CHKERRQ(ierr) + call PetscQuadratureDestroy(mechQuad,ierr); CHKERRQ(ierr) + +!-------------------------------------------------------------------------------------------------- +! Setup FEM mech boundary conditions + call DMGetLabel(mech_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr) + call DMPlexLabelComplete(mech_mesh,BCLabel,ierr); CHKERRQ(ierr) + call DMGetDefaultSection(mech_mesh,section,ierr); CHKERRQ(ierr) + allocate(numComp(1), source=dimPlex); pNumComp => numComp + allocate(numDof(dimPlex+1), source = 0); pNumDof => numDof + do topologDim = 0, dimPlex + call DMPlexGetDepthStratum(mech_mesh,topologDim,cellStart,cellEnd,ierr) + CHKERRQ(ierr) + call PetscSectionGetDof(section,cellStart,numDof(topologDim+1),ierr) + CHKERRQ(ierr) + enddo + numBC = 0 + do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries + if (fieldBC%componentBC(field)%Mask(faceSet)) numBC = numBC + 1 + enddo; enddo + allocate(bcField(numBC), source=0); pBcField => bcField + allocate(bcComps(numBC)); pBcComps => bcComps + allocate(bcPoints(numBC)); pBcPoints => bcPoints + numBC = 0 + do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries + if (fieldBC%componentBC(field)%Mask(faceSet)) then + numBC = numBC + 1 + call ISCreateGeneral(PETSC_COMM_WORLD,1,field-1,PETSC_COPY_VALUES,bcComps(numBC),ierr) + CHKERRQ(ierr) + call DMGetStratumSize(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcSize,ierr) + CHKERRQ(ierr) + if (bcSize > 0) then + call DMGetStratumIS(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcPoint,ierr) + CHKERRQ(ierr) + call ISGetIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr) + call ISCreateGeneral(PETSC_COMM_WORLD,bcSize,pBcPoint,PETSC_COPY_VALUES,bcPoints(numBC),ierr) + CHKERRQ(ierr) + call ISRestoreIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr) + call ISDestroy(bcPoint,ierr); CHKERRQ(ierr) + else + call ISCreateGeneral(PETSC_COMM_WORLD,0,0,PETSC_COPY_VALUES,bcPoints(numBC),ierr) + CHKERRQ(ierr) + endif + endif + enddo; enddo + call DMPlexCreateSection(mech_mesh,dimPlex,1,pNumComp,pNumDof, & + numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_OBJECT, & + section,ierr) + CHKERRQ(ierr) + call DMSetDefaultSection(mech_mesh,section,ierr); CHKERRQ(ierr) + do faceSet = 1, numBC + call ISDestroy(bcPoints(faceSet),ierr); CHKERRQ(ierr) + enddo + +!-------------------------------------------------------------------------------------------------- +! initialize solver specific parts of PETSc + call SNESCreate(PETSC_COMM_WORLD,mech_snes,ierr);CHKERRQ(ierr) + call SNESSetOptionsPrefix(mech_snes,'mech_',ierr);CHKERRQ(ierr) + call SNESSetDM(mech_snes,mech_mesh,ierr); CHKERRQ(ierr) !< set the mesh for non-linear solver + call DMCreateGlobalVector(mech_mesh,solution ,ierr); CHKERRQ(ierr) !< locally owned displacement Dofs + call DMCreateGlobalVector(mech_mesh,solution_rate ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step + call DMCreateLocalVector (mech_mesh,solution_local ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step + call DMSNESSetFunctionLocal(mech_mesh,FEM_mech_formResidual,PETSC_NULL_OBJECT,ierr) !< function to evaluate residual forces + CHKERRQ(ierr) + call DMSNESSetJacobianLocal(mech_mesh,FEM_mech_formJacobian,PETSC_NULL_OBJECT,ierr) !< function to evaluate stiffness matrix + CHKERRQ(ierr) + call SNESSetMaxLinearSolveFailures(mech_snes, huge(1), ierr); CHKERRQ(ierr) !< ignore linear solve failures + call SNESSetConvergenceTest(mech_snes,FEM_mech_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) + CHKERRQ(ierr) + call SNESSetTolerances(mech_snes,1.0,0.0,0.0,itmax,itmax,ierr) + CHKERRQ(ierr) + call SNESSetFromOptions(mech_snes,ierr); CHKERRQ(ierr) + +!-------------------------------------------------------------------------------------------------- +! init fields + call VecSet(solution ,0.0,ierr); CHKERRQ(ierr) + call VecSet(solution_rate ,0.0,ierr); CHKERRQ(ierr) + allocate(x_scal(cellDof)) + allocate(nodalPoints (dimPlex)) + allocate(nodalWeights(1)) + nodalPointsP => nodalPoints + nodalWeightsP => nodalWeights + allocate(v0(dimPlex)) + allocate(cellJ(dimPlex*dimPlex)) + allocate(invcellJ(dimPlex*dimPlex)) + allocate(cellJMat(dimPlex,dimPlex)) + pV0 => v0 + pCellJ => cellJ + pInvcellJ => invcellJ + call DMGetDefaultSection(mech_mesh,section,ierr); CHKERRQ(ierr) + call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr) + call PetscDSGetDiscretization(mechDS,0,mechFE,ierr) + CHKERRQ(ierr) + call PetscFEGetDualSpace(mechFE,mechDualSpace,ierr); CHKERRQ(ierr) + call DMPlexGetHeightStratum(mech_mesh,0,cellStart,cellEnd,ierr) + CHKERRQ(ierr) + do cell = cellStart, cellEnd-1 !< loop over all elements + x_scal = 0.0 + call DMPlexComputeCellGeometryAffineFEM(mech_mesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + cellJMat = reshape(pCellJ,shape=[dimPlex,dimPlex]) + do basis = 0, nBasis-1 + call PetscDualSpaceGetFunctional(mechDualSpace,basis,functional,ierr) + CHKERRQ(ierr) + call PetscQuadratureGetData(functional,dimPlex,nNodalPoints,nodalPointsP,nodalWeightsP,ierr) + CHKERRQ(ierr) + x_scal(basis*dimPlex+1:(basis+1)*dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0) + enddo + px_scal => x_scal + call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,INSERT_ALL_VALUES,ierr) + CHKERRQ(ierr) + enddo + +end subroutine FEM_mech_init + +!-------------------------------------------------------------------------------------------------- +!> @brief solution for the FEM load step +!-------------------------------------------------------------------------------------------------- +type(tSolutionState) function FEM_mech_solution( & + incInfoIn,timeinc,timeinc_old,fieldBC) + use numerics, only: & + itmax + use FEsolving, only: & + terminallyIll + + implicit none +!-------------------------------------------------------------------------------------------------- +! input data for solution + real(pReal), intent(in) :: & + timeinc, & !< increment in time for current solution + timeinc_old !< increment in time of last increment + type(tFieldBC), intent(in) :: & + fieldBC + character(len=*), intent(in) :: & + incInfoIn + +!-------------------------------------------------------------------------------------------------- +! + PetscErrorCode :: ierr + SNESConvergedReason :: reason + + incInfo = incInfoIn + FEM_mech_solution%converged =.false. +!-------------------------------------------------------------------------------------------------- +! set module wide availabe data + params%timeinc = timeinc + params%timeincOld = timeinc_old + params%fieldBC = fieldBC + + call SNESSolve(mech_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr) ! solve mech_snes based on solution guess (result in solution) + call SNESGetConvergedReason(mech_snes,reason,ierr); CHKERRQ(ierr) ! solution converged? + terminallyIll = .false. + + if (reason < 1) then ! 0: still iterating (will not occur), negative -> convergence error + FEM_mech_solution%converged = .false. + FEM_mech_solution%iterationsNeeded = itmax + else ! >= 1 proper convergence (or terminally ill) + FEM_mech_solution%converged = .true. + call SNESGetIterationNumber(mech_snes,FEM_mech_solution%iterationsNeeded,ierr) + CHKERRQ(ierr) + endif + + if (worldrank == 0) then + write(6,'(/,a)') ' ===========================================================================' + flush(6) + endif + +end function FEM_mech_solution + + +!-------------------------------------------------------------------------------------------------- +!> @brief forms the FEM residual vector +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) + use numerics, only: & + BBarStabilisation + use FEM_utilities, only: & + utilities_projectBCValues, & + utilities_constitutiveResponse + use homogenization, only: & + materialpoint_F, & + materialpoint_P + use math, only: & + math_det33, & + math_inv33 + use FEsolving, only: & + terminallyIll + + implicit none + DM :: dm_local + PetscDS :: prob + Vec :: x_local, f_local, xx_local + PetscSection :: section + PetscScalar, dimension(:), pointer :: x_scal, pf_scal + PetscScalar, target :: f_scal(cellDof) + PetscReal :: detJ, IcellJMat(dimPlex,dimPlex) + PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), & + invcellJ(dimPlex*dimPlex) + PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) + PetscReal, pointer :: basisField(:), basisFieldDer(:) + PetscInt :: cellStart, cellEnd, cell, field, face, & + qPt, basis, comp, cidx + PetscReal :: detFAvg + PetscReal :: BMat(dimPlex*dimPlex,cellDof) + PetscObject :: dummy + PetscInt :: bcSize + IS :: bcPoints + PetscErrorCode :: ierr + + pV0 => v0 + pCellJ => cellJ + pInvcellJ => invcellJ + call DMGetDefaultSection(dm_local,section,ierr); CHKERRQ(ierr) + call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) + call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr) + CHKERRQ(ierr) + call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + call VecWAXPY(x_local,1.0,xx_local,solution_local,ierr); CHKERRQ(ierr) + do field = 1, dimPlex; do face = 1, mesh_Nboundaries + if (params%fieldBC%componentBC(field)%Mask(face)) then + call DMGetStratumSize(dm_local,'Face Sets',mesh_boundaries(face),bcSize,ierr) + if (bcSize > 0) then + call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,ierr) + CHKERRQ(ierr) + call utilities_projectBCValues(x_local,section,0,field-1,bcPoints, & + 0.0,params%fieldBC%componentBC(field)%Value(face),params%timeinc) + call ISDestroy(bcPoints,ierr); CHKERRQ(ierr) + endif + endif + enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! evaluate field derivatives + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexVecGetClosure(dm_local,section,x_local,cell,x_scal,ierr) !< get Dofs belonging to element + CHKERRQ(ierr) + call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex]) + do qPt = 0, nQuadrature-1 + BMat = 0.0 + 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*dimPlex+cidx )*dimPlex+1: & + (qPt*nBasis*dimPlex+cidx+1)*dimPlex )) + enddo + enddo + materialpoint_F(1:dimPlex,1:dimPlex,qPt+1,cell+1) = & + reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1]) + enddo + if (BBarStabilisation) then + detFAvg = math_det33(sum(materialpoint_F(1:3,1:3,1:nQuadrature,cell+1),dim=3)/real(nQuadrature)) + do qPt = 1, nQuadrature + materialpoint_F(1:dimPlex,1:dimPlex,qPt,cell+1) = & + materialpoint_F(1:dimPlex,1:dimPlex,qPt,cell+1)* & + (detFAvg/math_det33(materialpoint_F(1:3,1:3,qPt,cell+1)))**(1.0/real(dimPlex)) + + enddo + endif + call DMPlexVecRestoreClosure(dm_local,section,x_local,cell,x_scal,ierr) + CHKERRQ(ierr) + enddo + +!-------------------------------------------------------------------------------------------------- +! evaluate constitutive response + call Utilities_constitutiveResponse(params%timeinc,P_av,ForwardData) + call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) + ForwardData = .false. + +!-------------------------------------------------------------------------------------------------- +! integrating residual + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexVecGetClosure(dm_local,section,x_local,cell,x_scal,ierr) !< get Dofs belonging to element + CHKERRQ(ierr) + call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex]) + f_scal = 0.0 + do qPt = 0, nQuadrature-1 + BMat = 0.0 + 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*dimPlex+cidx )*dimPlex+1: & + (qPt*nBasis*dimPlex+cidx+1)*dimPlex )) + enddo + enddo + f_scal = f_scal + & + matmul(transpose(BMat), & + reshape(transpose(materialpoint_P(1:dimPlex,1:dimPlex,qPt+1,cell+1)), & + shape=[dimPlex*dimPlex]))*qWeights(qPt+1) + enddo + f_scal = f_scal*abs(detJ) + pf_scal => f_scal + call DMPlexVecSetClosure(dm_local,section,f_local,cell,pf_scal,ADD_VALUES,ierr) + CHKERRQ(ierr) + call DMPlexVecRestoreClosure(dm_local,section,x_local,cell,x_scal,ierr) + CHKERRQ(ierr) + enddo + call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + +end subroutine FEM_mech_formResidual + + +!-------------------------------------------------------------------------------------------------- +!> @brief forms the FEM stiffness matrix +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) + use numerics, only: & + BBarStabilisation + use homogenization, only: & + materialpoint_dPdF, & + materialpoint_F + use math, only: & + math_inv33, & + math_identity2nd, & + math_det33 + use FEM_utilities, only: & + utilities_projectBCValues + + implicit none + + DM :: dm_local + PetscDS :: prob + Vec :: x_local, xx_local + Mat :: Jac_pre, Jac + PetscSection :: section, gSection + PetscReal :: detJ, IcellJMat(dimPlex,dimPlex) + PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), & + invcellJ(dimPlex*dimPlex) + PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) + PetscReal, dimension(:), pointer :: basisField, basisFieldDer + PetscInt :: cellStart, cellEnd, cell, field, face, & + qPt, basis, comp, cidx + PetscScalar, target :: K_e (cellDof,cellDof), & + K_eA (cellDof,cellDof), & + K_eB (cellDof,cellDof), & + K_eVec(cellDof*cellDof) + PetscReal :: BMat (dimPlex*dimPlex,cellDof), & + BMatAvg(dimPlex*dimPlex,cellDof), & + MatA (dimPlex*dimPlex,cellDof), & + MatB (1 ,cellDof) + PetscScalar, dimension(:), pointer :: pK_e, x_scal + PetscReal, dimension(3,3) :: F = math_I3, FAvg, FInv + PetscObject :: dummy + PetscInt :: bcSize + IS :: bcPoints + PetscErrorCode :: ierr + + pV0 => v0 + pCellJ => cellJ + pInvcellJ => invcellJ + call MatSetOption(Jac,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE,ierr); CHKERRQ(ierr) + call MatSetOption(Jac,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE,ierr); CHKERRQ(ierr) + call MatZeroEntries(Jac,ierr); CHKERRQ(ierr) + call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) + call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr) + call DMGetDefaultSection(dm_local,section,ierr); CHKERRQ(ierr) + call DMGetDefaultGlobalSection(dm_local,gSection,ierr); CHKERRQ(ierr) + + call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + call VecWAXPY(x_local,1.0,xx_local,solution_local,ierr); CHKERRQ(ierr) + do field = 1, dimPlex; do face = 1, mesh_Nboundaries + if (params%fieldBC%componentBC(field)%Mask(face)) then + call DMGetStratumSize(dm_local,'Face Sets',mesh_boundaries(face),bcSize,ierr) + if (bcSize > 0) then + call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,ierr) + CHKERRQ(ierr) + call utilities_projectBCValues(x_local,section,0,field-1,bcPoints, & + 0.0,params%fieldBC%componentBC(field)%Value(face),params%timeinc) + call ISDestroy(bcPoints,ierr); CHKERRQ(ierr) + endif + endif + enddo; enddo + call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexVecGetClosure(dm_local,section,x_local,cell,x_scal,ierr) !< get Dofs belonging to element + CHKERRQ(ierr) + call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + IcellJMat = reshape(pInvcellJ, shape = [dimPlex,dimPlex]) + K_eA = 0.0 + K_eB = 0.0 + MatB = 0.0 + FAvg = 0.0 + BMatAvg = 0.0 + do qPt = 0, nQuadrature-1 + BMat = 0.0 + 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*dimPlex+cidx )*dimPlex+1: & + (qPt*nBasis*dimPlex+cidx+1)*dimPlex )) + enddo + enddo + MatA = matmul(reshape(reshape(materialpoint_dPdF(1:dimPlex,1:dimPlex,1:dimPlex,1:dimPlex,qPt+1,cell+1), & + shape=[dimPlex,dimPlex,dimPlex,dimPlex], order=[2,1,4,3]), & + shape=[dimPlex*dimPlex,dimPlex*dimPlex]),BMat)*qWeights(qPt+1) + if (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_eB = K_eB - & + matmul(transpose(matmul(reshape(materialpoint_F(1:dimPlex,1:dimPlex,qPt+1,cell+1), & + shape=[dimPlex*dimPlex,1]), & + matmul(reshape(FInv(1:dimPlex,1:dimPlex), & + shape=[1,dimPlex*dimPlex],order=[2,1]),BMat))),MatA) + MatB = MatB + & + matmul(reshape(materialpoint_F(1:dimPlex,1:dimPlex,qPt+1,cell+1),shape=[1,dimPlex*dimPlex]),MatA) + FAvg = FAvg + F + BMatAvg = BMatAvg + BMat + else + K_eA = K_eA + matmul(transpose(BMat),MatA) + endif + enddo + if (BBarStabilisation) then + FInv = math_inv33(FAvg) + K_e = K_eA*math_det33(FAvg/real(nQuadrature))**(1.0/real(dimPlex)) + & + (matmul(matmul(transpose(BMatAvg), & + reshape(FInv(1:dimPlex,1:dimPlex),shape=[dimPlex*dimPlex,1],order=[2,1])),MatB) + & + K_eB)/real(dimPlex) + + else + K_e = K_eA + endif + K_e = K_e + eps*math_identity2nd(cellDof) + K_eVec = reshape(K_e, [cellDof*cellDof])*abs(detJ) + pK_e => K_eVec + call DMPlexMatSetClosure(dm_local,section,gSection,Jac,cell,pK_e,ADD_VALUES,ierr) + CHKERRQ(ierr) + call DMPlexVecRestoreClosure(dm_local,section,x_local,cell,x_scal,ierr) + CHKERRQ(ierr) + enddo + call MatAssemblyBegin(Jac,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr) + call MatAssemblyEnd(Jac,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr) + call MatAssemblyBegin(Jac_pre,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr) + call MatAssemblyEnd(Jac_pre,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr) + call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + +!-------------------------------------------------------------------------------------------------- +! apply boundary conditions + call DMPlexCreateRigidBody(dm_local,matnull,ierr); CHKERRQ(ierr) + call MatSetNullSpace(Jac,matnull,ierr); CHKERRQ(ierr) + call MatSetNearNullSpace(Jac,matnull,ierr); CHKERRQ(ierr) + call MatNullSpaceDestroy(matnull,ierr); CHKERRQ(ierr) + +end subroutine FEM_mech_formJacobian + +!-------------------------------------------------------------------------------------------------- +!> @brief forwarding routine +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_forward(guess,timeinc,timeinc_old,fieldBC) + use FEM_utilities, only: & + cutBack + use homogenization, only: & + materialpoint_F0, & + materialpoint_F + use FEM_utilities, only: & + utilities_projectBCValues + + implicit none + type(tFieldBC), intent(in) :: & + fieldBC + real(pReal), intent(in) :: & + timeinc_old, & + timeinc + logical, intent(in) :: & + guess + PetscInt :: field, face + DM :: dm_local + Vec :: x_local + PetscSection :: section + PetscInt :: bcSize + IS :: bcPoints + PetscErrorCode :: ierr + +!-------------------------------------------------------------------------------------------------- +! forward last inc + if (guess .and. .not. cutBack) then + ForwardData = .True. + materialpoint_F0 = materialpoint_F + call SNESGetDM(mech_snes,dm_local,ierr); CHKERRQ(ierr) !< retrieve mesh info from mech_snes into dm_local + call DMGetDefaultSection(dm_local,section,ierr); CHKERRQ(ierr) + call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + call VecSet(x_local,0.0,ierr); CHKERRQ(ierr) + call DMGlobalToLocalBegin(dm_local,solution,INSERT_VALUES,x_local,ierr) !< retrieve my partition of global solution vector + CHKERRQ(ierr) + call DMGlobalToLocalEnd(dm_local,solution,INSERT_VALUES,x_local,ierr) + CHKERRQ(ierr) + call VecAXPY(solution_local,1.0,x_local,ierr); CHKERRQ(ierr) + 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,ierr) + if (bcSize > 0) then + call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,ierr) + CHKERRQ(ierr) + call utilities_projectBCValues(solution_local,section,0,field-1,bcPoints, & + 0.0,fieldBC%componentBC(field)%Value(face),timeinc_old) + call ISDestroy(bcPoints,ierr); CHKERRQ(ierr) + endif + endif + enddo; enddo + call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + +!-------------------------------------------------------------------------------------------------- +! update rate and forward last inc + call VecCopy(solution,solution_rate,ierr); CHKERRQ(ierr) + call VecScale(solution_rate,1.0/timeinc_old,ierr); CHKERRQ(ierr) + endif + call VecCopy(solution_rate,solution,ierr); CHKERRQ(ierr) + call VecScale(solution,timeinc,ierr); CHKERRQ(ierr) + +end subroutine FEM_mech_forward + + +!-------------------------------------------------------------------------------------------------- +!> @brief reporting +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr) + use numerics, only: & + err_struct_tolAbs, & + err_struct_tolRel + use IO, only: & + IO_intOut + use FEsolving, only: & + terminallyIll + + implicit none + SNES :: snes_local + PetscInt :: PETScIter + PetscReal :: xnorm,snorm,fnorm,divTol + SNESConvergedReason :: reason + PetscObject :: dummy + PetscErrorCode :: ierr + +!-------------------------------------------------------------------------------------------------- +! report + divTol = max(maxval(abs(P_av(1:dimPlex,1:dimPlex)))*err_struct_tolRel,err_struct_tolAbs) + call SNESConvergedDefault(snes_local,PETScIter,xnorm,snorm,fnorm/divTol,reason,dummy,ierr) + CHKERRQ(ierr) + if (terminallyIll) reason = SNES_DIVERGED_FUNCTION_DOMAIN + if (worldrank == 0) then + write(6,'(1/,1x,a,a,i0,a,i0,f0.3)') trim(incInfo), & + ' @ Iteration ',PETScIter,' mechanical residual norm = ', & + int(fnorm/divTol),fnorm/divTol-int(fnorm/divTol) + write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',& + transpose(P_av)*1.e-6_pReal + flush(6) + endif + +end subroutine FEM_mech_converged + +!-------------------------------------------------------------------------------------------------- +!> @brief output routine +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_output(inc,fieldBC) + use material, only: & + material_Nhomogenization, & + material_Ncrystallite, & + material_Nphase, & + homogenization_maxNgrains, & + homogenization_name, & + crystallite_name, & + phase_name + use homogenization, only: & + homogOutput, & + crystalliteOutput, & + phaseOutput + use numerics, only: & + integrationOrder + use FEM_utilities, only: & + resUnit, & + coordinatesVec, & + homogenizationResultsVec, & + crystalliteResultsVec, & + phaseResultsVec + + implicit none + integer(pInt), intent(in) :: inc + type(tFieldBC),intent(in) :: fieldBC + DM :: dm_local + PetscDS :: prob + Vec :: localVec + PetscScalar, dimension(:), pointer :: x_scal, coordinates, results + PetscSection :: section + PetscReal, pointer :: basisField(:), basisFieldDer(:) + PetscInt :: nodeStart, nodeEnd, node + PetscInt :: faceStart, faceEnd, face + PetscInt :: cellStart, cellEnd, cell + PetscInt :: field, qPt, qOffset, fOffset, dim, gType, cSize + PetscInt :: homog, cryst, grain, phase, res, resSize + PetscErrorCode :: ierr + character(len=1024) :: resultPartition, incPartition, homogPartition, & + crystPartition, phasePartition, & + grainStr + integer(pInt) :: ctr + + write(incPartition,'(a11,i0)') '/Increment_',inc + call PetscViewerHDF5PushGroup(resUnit, trim(incPartition), ierr); CHKERRQ(ierr) + call SNESGetDM(mech_snes,dm_local,ierr); CHKERRQ(ierr) !< retrieve mesh info from mech_snes into dm_local + call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) !< retrieve discretization from mesh and store in prob + call DMGetDefaultSection(dm_local,section,ierr); CHKERRQ(ierr) !< retrieve section (degrees of freedom) + call DMGetLocalVector(dm_local,localVec,ierr); CHKERRQ(ierr) !< retrieve local vector + call VecCopy(solution_local,localVec,ierr); CHKERRQ(ierr) + + call VecGetArrayF90(coordinatesVec, coordinates, ierr); CHKERRQ(ierr) + ctr = 1_pInt + select case (integrationOrder) + case(1_pInt) !< first order quadrature + call DMPlexGetDepthStratum(dm_local,0,nodeStart,nodeEnd,ierr); CHKERRQ(ierr) !< get index range of entities at dimension 0 (i.e., all nodes) + do node = nodeStart, nodeEnd-1 !< loop over all nodes in mesh + call DMPlexVecGetClosure(dm_local,section,localVec,node,x_scal,ierr) !< x_scal = localVec (i.e. solution) at node + CHKERRQ(ierr) + do dim = 1, dimPlex + coordinates(ctr) = x_scal(dim); ctr = ctr + 1_pInt !< coordinates of node + enddo + call DMPlexVecRestoreClosure(dm_local,section,localVec,node,x_scal,ierr) !< disassociate x_scal pointer + CHKERRQ(ierr) + enddo + case(2_pInt) !< second order quadrature + call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr) !< get index range of highest dimension object (i.e. cells of mesh) TODO 3D assumption!! + CHKERRQ(ierr) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexVecGetClosure(dm_local,section,localVec,cell,x_scal,ierr) + CHKERRQ(ierr) + do dim = 1, dimPlex + coordinates(ctr) = sum(x_scal(dim:cellDof:dimPlex))/real(nBasis) !< coordinates of cell center + ctr = ctr + 1_pInt + enddo + call DMPlexVecRestoreClosure(dm_local,section,localVec,cell,x_scal,ierr) + CHKERRQ(ierr) + enddo + call DMPlexGetDepthStratum(dm_local,0,nodeStart,nodeEnd,ierr) !< get index range of entities at dimension 0 (i.e., all nodes) + CHKERRQ(ierr) + do node = nodeStart, nodeEnd-1 !< loop over all nodes + call DMPlexVecGetClosure(dm_local,section,localVec,node,x_scal,ierr) + CHKERRQ(ierr) + do dim = 1, dimPlex + coordinates(ctr) = x_scal(dim) !< coordinates of cell corners + ctr = ctr + 1_pInt + enddo + call DMPlexVecRestoreClosure(dm_local,section,localVec,node,x_scal,ierr) + CHKERRQ(ierr) + enddo + do gType = 1, dimPlex-1 + call DMPlexGetHeightStratum(dm_local,gType,faceStart,faceEnd,ierr) !< get index range of entities at dimension N-1 (i.e., all faces) + CHKERRQ(ierr) + do face = faceStart, faceEnd-1 !< loop over all elements + call DMPlexVecGetClosure(dm_local,section,localVec,face,x_scal,ierr) + CHKERRQ(ierr) + cSize = size(x_scal) + do dim = 1, dimPlex + coordinates(ctr) = sum(x_scal(dim:cSize:dimPlex))/real(cSize/dimPlex) !< coordinates of edge/face centers TODO quadratic element assumption used here! + ctr = ctr + 1_pInt + enddo + call DMPlexVecRestoreClosure(dm_local,section,localVec,face,x_scal,ierr) + CHKERRQ(ierr) + enddo + enddo + case default + call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr) !< get index range of elements (mesh cells) + CHKERRQ(ierr) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexVecGetClosure(dm_local, & !< mesh + section, & !< distribution of DoF on mesh + localVec, & !< overall solution vector (i.e. all DoFs)... + cell, & !< ...at this cell + x_scal, & !< store all DoFs of closure (faces, edges, nodes if present) into x_scal + ierr) !< --> get coordinates of closure entities with DoFs + CHKERRQ(ierr) + qOffset = 0 + do qPt = 1, nQuadrature !< loop over each quad point in cell + fOffset = 0 + do field = 0, dimPlex-1 !< loop over each solution field (e.g., x,y,z coordinates) + call PetscDSGetTabulation(prob,field,basisField,basisFieldDer,ierr) !< retrieve shape function at each quadrature point for field + CHKERRQ(ierr) + coordinates(ctr) = real(sum(basisField(qOffset+1:qOffset+nBasis)* & + x_scal(fOffset+1:fOffset+nBasis)), pReal) !< interpolate field value (in x_scal) to quad points + ctr = ctr + 1_pInt + fOffset = fOffset + nBasis !< wind forward by one field + enddo + qOffset = qOffset + nBasis !< wind forward by one quad point + enddo + call DMPlexVecRestoreClosure(dm_local,section,localVec,cell,x_scal,ierr) + CHKERRQ(ierr) + enddo + end select + call VecRestoreArrayF90(coordinatesVec, coordinates, ierr); CHKERRQ(ierr) + call VecAssemblyBegin(coordinatesVec, ierr); CHKERRQ(ierr) + call VecAssemblyEnd (coordinatesVec, ierr); CHKERRQ(ierr) + call VecView(coordinatesVec, resUnit, ierr); CHKERRQ(ierr) + call DMRestoreLocalVector(dm_local,localVec,ierr); CHKERRQ(ierr) + + do homog = 1, material_Nhomogenization + call VecGetSize(homogenizationResultsVec(homog),resSize,ierr) + if (resSize > 0) then + homogPartition = trim(incPartition)//'/Homog_'//trim(homogenization_name(homog)) + call PetscViewerHDF5PushGroup(resUnit, homogPartition, ierr) + CHKERRQ(ierr) + do res = 1, homogOutput(homog)%sizeResults + write(resultPartition,'(a12,i0)') 'homogResult_',res + call PetscObjectSetName(homogenizationResultsVec(homog),trim(resultPartition),ierr) + CHKERRQ(ierr) + call VecGetArrayF90(homogenizationResultsVec(homog),results,ierr);CHKERRQ(ierr) + results = homogOutput(homog)%output(res,:) + call VecRestoreArrayF90(homogenizationResultsVec(homog), results, ierr) + CHKERRQ(ierr) + call VecAssemblyBegin(homogenizationResultsVec(homog), ierr); CHKERRQ(ierr) + call VecAssemblyEnd (homogenizationResultsVec(homog), ierr); CHKERRQ(ierr) + call VecView(homogenizationResultsVec(homog), resUnit, ierr); CHKERRQ(ierr) + enddo + call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr) + endif + enddo + do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains + call VecGetSize(crystalliteResultsVec(cryst,grain),resSize,ierr) + if (resSize > 0) then + write(grainStr,'(a,i0)') 'Grain',grain + crystPartition = trim(incPartition)//'/Crystallite_'//trim(crystallite_name(cryst))//'_'//trim(grainStr) + call PetscViewerHDF5PushGroup(resUnit, crystPartition, ierr) + CHKERRQ(ierr) + do res = 1, crystalliteOutput(cryst,grain)%sizeResults + write(resultPartition,'(a18,i0)') 'crystalliteResult_',res + call PetscObjectSetName(crystalliteResultsVec(cryst,grain),trim(resultPartition),ierr) + CHKERRQ(ierr) + call VecGetArrayF90(crystalliteResultsVec(cryst,grain),results,ierr) + CHKERRQ(ierr) + results = crystalliteOutput(cryst,grain)%output(res,:) + call VecRestoreArrayF90(crystalliteResultsVec(cryst,grain), results, ierr) + CHKERRQ(ierr) + call VecAssemblyBegin(crystalliteResultsVec(cryst,grain), ierr);CHKERRQ(ierr) + call VecAssemblyEnd (crystalliteResultsVec(cryst,grain), ierr);CHKERRQ(ierr) + call VecView(crystalliteResultsVec(cryst,grain), resUnit, ierr);CHKERRQ(ierr) + enddo + call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr) + endif + enddo; enddo + do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains + call VecGetSize(phaseResultsVec(phase,grain),resSize,ierr) + if (resSize > 0) then + write(grainStr,'(a,i0)') 'Grain',grain + phasePartition = trim(incPartition)//'/Phase_'//trim(phase_name(phase))//'_'//trim(grainStr) + call PetscViewerHDF5PushGroup(resUnit, phasePartition, ierr) + CHKERRQ(ierr) + do res = 1, phaseOutput(phase,grain)%sizeResults + write(resultPartition,'(a12,i0)') 'phaseResult_',res + call PetscObjectSetName(phaseResultsVec(phase,grain),trim(resultPartition),ierr) + CHKERRQ(ierr) + call VecGetArrayF90(phaseResultsVec(phase,grain),results,ierr);CHKERRQ(ierr) + results = phaseOutput(phase,grain)%output(res,:) + call VecRestoreArrayF90(phaseResultsVec(phase,grain), results, ierr) + CHKERRQ(ierr) + call VecAssemblyBegin(phaseResultsVec(phase,grain), ierr); CHKERRQ(ierr) + call VecAssemblyEnd (phaseResultsVec(phase,grain), ierr); CHKERRQ(ierr) + call VecView(phaseResultsVec(phase,grain), resUnit, ierr); CHKERRQ(ierr) + enddo + call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr) + endif + enddo; enddo + +end subroutine FEM_mech_output + +!-------------------------------------------------------------------------------------------------- +!> @brief destroy routine +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_destroy() + + implicit none + PetscErrorCode :: ierr + + call VecDestroy(solution,ierr); CHKERRQ(ierr) + call VecDestroy(solution_rate,ierr); CHKERRQ(ierr) + call SNESDestroy(mech_snes,ierr); CHKERRQ(ierr) + +end subroutine FEM_mech_destroy + +end module FEM_mech diff --git a/src/FEM_mesh.f90 b/src/FEM_mesh.f90 new file mode 100644 index 000000000..82b91ddc9 --- /dev/null +++ b/src/FEM_mesh.f90 @@ -0,0 +1,446 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Driver controlling inner and outer load case looping of the FEM solver +!> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing +!> results +!-------------------------------------------------------------------------------------------------- +module mesh + use, intrinsic :: iso_c_binding + use prec, only: pReal, pInt + + implicit none +#include + private + integer(pInt), public, protected :: & + mesh_Nboundaries, & + mesh_NcpElems, & !< total number of CP elements in mesh + mesh_NcpElemsGlobal, & + mesh_Nnodes, & !< total number of nodes in mesh + mesh_maxNnodes, & !< max number of nodes in any CP element + mesh_maxNips, & !< max number of IPs in any CP element + mesh_maxNipNeighbors, & + mesh_Nelems !< total number of elements in mesh + + real(pReal), public, protected :: charLength + + integer(pInt), dimension(:,:), allocatable, public, protected :: & + mesh_element !< FEid, type(internal representation), material, texture, node indices as CP IDs + + real(pReal), dimension(:,:), allocatable, public :: & + mesh_node !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + + real(pReal), dimension(:,:), allocatable, public, protected :: & + mesh_ipVolume, & !< volume associated with IP (initially!) + mesh_node0 !< node x,y,z coordinates (initially!) + + real(pReal), dimension(:,:,:), allocatable, public :: & + mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) + + real(pReal), dimension(:,:,:), allocatable, public, protected :: & + mesh_ipArea !< area of interface to neighboring IP (initially!) + + real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) + + integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] + + logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) + + integer(pInt), dimension(:,:), allocatable, target, private :: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] + + DM, public :: geomMesh + + integer(pInt), dimension(:), allocatable, public, protected :: & + mesh_boundaries + +! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) +! Hence, I suggest to prefix with "FE_" + + integer(pInt), parameter, public :: & + FE_Nelemtypes = 1_pInt, & + FE_Ngeomtypes = 1_pInt, & + FE_Ncelltypes = 1_pInt, & + FE_maxNnodes = 1_pInt, & + FE_maxNips = 14_pInt + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type + int([1],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type + int([1],pInt) + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element + int([0],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), public :: FE_Nips = & !< number of IPs in a specific type of element + int([0],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + int([6],pInt) + + + public :: & + mesh_init, & + mesh_FEasCP, & + mesh_FEM_build_ipVolumes, & + mesh_FEM_build_ipCoordinates, & + mesh_cellCenterCoordinates + + external :: & + MPI_abort, & + MPI_Bcast, & + DMClone, & + DMGetDimension, & + DMPlexCreateFromFile, & + DMPlexDistribute, & + DMPlexCopyCoordinates, & + DMGetStratumSize, & + DMPlexGetHeightStratum, & + DMPlexGetLabelValue, & + DMPlexSetLabelValue, & + DMDestroy + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes the mesh by calling all necessary private routines the mesh module +!! Order and routines strongly depend on type of solver +!-------------------------------------------------------------------------------------------------- +subroutine mesh_init(ip,el) + use DAMASK_interface + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use IO, only: & + IO_timeStamp, & + IO_error, & + IO_open_file, & + IO_stringPos, & + IO_intValue, & + IO_EOF, & + IO_read, & + IO_isBlank + use debug, only: & + debug_e, & + debug_i + use numerics, only: & + usePingPong, & + integrationOrder, & + worldrank, & + worldsize + use FEsolving, only: & + FEsolving_execElem, & + FEsolving_execIP, & + calcMode + use FEM_Zoo, only: & + FEM_Zoo_nQuadrature, & + FEM_Zoo_QuadraturePoints + + implicit none + integer(pInt), parameter :: FILEUNIT = 222_pInt + integer(pInt), intent(in) :: el, ip + integer(pInt) :: j + integer(pInt), allocatable, dimension(:) :: chunkPos + integer :: dimPlex + character(len=512) :: & + line + logical :: flag + PetscSF :: sf + DM :: globalMesh + PetscInt :: face, nFaceSets + PetscInt, pointer :: pFaceSets(:) + IS :: faceSetIS + PetscErrorCode :: ierr + + + if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- mesh init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif + + if (allocated(mesh_mapFEtoCPelem)) deallocate(mesh_mapFEtoCPelem) + if (allocated(mesh_mapFEtoCPnode)) deallocate(mesh_mapFEtoCPnode) + if (allocated(mesh_node0)) deallocate(mesh_node0) + if (allocated(mesh_node)) deallocate(mesh_node) + if (allocated(mesh_element)) deallocate(mesh_element) + if (allocated(mesh_ipCoordinates)) deallocate(mesh_ipCoordinates) + if (allocated(mesh_ipVolume)) deallocate(mesh_ipVolume) + + call DMPlexCreateFromFile(PETSC_COMM_WORLD,geometryFile,PETSC_TRUE,globalMesh,ierr) + CHKERRQ(ierr) + call DMGetDimension(globalMesh,dimPlex,ierr) + CHKERRQ(ierr) + call DMGetStratumSize(globalMesh,'depth',dimPlex,mesh_NcpElemsGlobal,ierr) + CHKERRQ(ierr) + call DMGetLabelSize(globalMesh,'Face Sets',mesh_Nboundaries,ierr) + CHKERRQ(ierr) + call MPI_Bcast(mesh_Nboundaries,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + call MPI_Bcast(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + call MPI_Bcast(dimPlex,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + + allocate(mesh_boundaries(mesh_Nboundaries), source = 0_pInt) + call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr) + CHKERRQ(ierr) + call DMGetLabelIdIS(globalMesh,'Face Sets',faceSetIS,ierr) + CHKERRQ(ierr) + if (nFaceSets > 0) call ISGetIndicesF90(faceSetIS,pFaceSets,ierr) + do face = 1, nFaceSets + mesh_boundaries(face) = pFaceSets(face) + enddo + if (nFaceSets > 0) call ISRestoreIndicesF90(faceSetIS,pFaceSets,ierr) + call MPI_Bcast(mesh_boundaries,mesh_Nboundaries,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + + if (worldrank == 0) then + j = 0 + flag = .false. + call IO_open_file(FILEUNIT,trim(geometryFile)) + do + read(FILEUNIT,'(a512)') line + if (trim(line) == IO_EOF) exit ! skip empty lines + if (trim(line) == '$Elements') then + read(FILEUNIT,'(a512)') line + read(FILEUNIT,'(a512)') line + flag = .true. + endif + if (trim(line) == '$EndElements') exit + if (flag) then + chunkPos = IO_stringPos(line) + if (chunkPos(1) == 3+IO_intValue(line,chunkPos,3)+dimPlex+1) then + call DMSetLabelValue(globalMesh,'material',j,IO_intValue(line,chunkPos,4),ierr) + CHKERRQ(ierr) + j = j + 1 + endif ! count all identifiers to allocate memory and do sanity check + endif + enddo + close (FILEUNIT) + endif + + if (worldsize > 1) then + call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr) + CHKERRQ(ierr) + else + call DMClone(globalMesh,geomMesh,ierr) + CHKERRQ(ierr) + endif + call DMDestroy(globalMesh,ierr); CHKERRQ(ierr) + + call DMGetStratumSize(geomMesh,'depth',dimPlex,mesh_Nelems,ierr) + CHKERRQ(ierr) + call DMGetStratumSize(geomMesh,'depth',0,mesh_Nnodes,ierr) + CHKERRQ(ierr) + mesh_NcpElems = mesh_Nelems + call mesh_FEM_mapNodesAndElems + + FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder) + mesh_maxNnodes = FE_Nnodes(1_pInt) + mesh_maxNips = FE_Nips(1_pInt) + call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p) + call mesh_FEM_build_ipVolumes(dimPlex) + + allocate (mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems)); mesh_element = 0_pInt + do j = 1, mesh_NcpElems + mesh_element( 1,j) = j + mesh_element( 2,j) = 1_pInt ! elem type + mesh_element( 3,j) = 1_pInt ! homogenization + call DMGetLabelValue(geomMesh,'material',j-1,mesh_element(4,j),ierr) + CHKERRQ(ierr) + end do + + if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & + call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements + if (debug_e < 1 .or. debug_e > mesh_NcpElems) & + call IO_error(602_pInt,ext_msg='element') ! selected element does not exist + if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & + call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP + + FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements + if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP) + allocate(FEsolving_execIP(2_pInt,mesh_NcpElems)); FEsolving_execIP = 1_pInt ! parallel loop bounds set to comprise from first IP... + forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element + + if (allocated(calcMode)) deallocate(calcMode) + allocate(calcMode(mesh_maxNips,mesh_NcpElems)) + calcMode = .false. ! pretend to have collected what first call is asking (F = I) + calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" + +end subroutine mesh_init + +!-------------------------------------------------------------------------------------------------- +!> @brief Gives the FE to CP ID mapping by binary search through lookup array +!! valid questions (what) are 'elem', 'node' +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_FEasCP(what,myID) + use IO, only: & + IO_lc + + implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID + + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center + + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),pInt) + + if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2_pInt,lower) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch + +end function mesh_FEasCP + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), intent(in) :: el, & !< element number + ip !< integration point number + real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell + + end function mesh_cellCenterCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_FEM_build_ipVolumes(dimPlex) + use math, only: & + math_I3, & + math_det33 + + implicit none + PetscInt :: dimPlex + PetscReal :: vol + PetscReal, target :: cent(dimPlex), norm(dimPlex) + PetscReal, pointer :: pCent(:), pNorm(:) + PetscInt :: cellStart, cellEnd, cell + PetscErrorCode :: ierr + + if (.not. allocated(mesh_ipVolume)) then + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) + mesh_ipVolume = 0.0_pReal + endif + + call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + pCent => cent + pNorm => norm + do cell = cellStart, cellEnd-1 + call DMPlexComputeCellGeometryFVM(geomMesh,cell,vol,pCent,pNorm,ierr) + CHKERRQ(ierr) + mesh_ipVolume(:,cell+1) = vol/real(mesh_maxNips,pReal) + enddo + +end subroutine mesh_FEM_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints) + + implicit none + PetscInt, intent(in) :: dimPlex + PetscReal, intent(in) :: qPoints(mesh_maxNips*dimPlex) + PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), invcellJ(dimPlex*dimPlex) + PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) + PetscReal :: detJ + PetscInt :: cellStart, cellEnd, cell, qPt, dirI, dirJ, qOffset + PetscErrorCode :: ierr + + if (.not. allocated(mesh_ipCoordinates)) then + allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems)) + mesh_ipCoordinates = 0.0_pReal + endif + + pV0 => v0 + pCellJ => cellJ + pInvcellJ => invcellJ + call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexComputeCellGeometryAffineFEM(geomMesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + qOffset = 0 + do qPt = 1, mesh_maxNips + do dirI = 1, dimPlex + 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) + enddo + enddo + qOffset = qOffset + dimPlex + enddo + enddo + +end subroutine mesh_FEM_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief fake map node from FE ID to internal (consecutive) representation for node and element +!! Allocates global array 'mesh_mapFEtoCPnode' and 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_FEM_mapNodesAndElems + use math, only: & + math_range + + implicit none + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source = 0_pInt) + allocate (mesh_mapFEtoCPelem(2_pInt,mesh_NcpElems), source = 0_pInt) + + mesh_mapFEtoCPnode = spread(math_range(mesh_Nnodes),1,2) + mesh_mapFEtoCPelem = spread(math_range(mesh_NcpElems),1,2) + +end subroutine mesh_FEM_mapNodesAndElems + + +end module mesh diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 new file mode 100644 index 000000000..621a32508 --- /dev/null +++ b/src/FEM_utilities.f90 @@ -0,0 +1,819 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Utilities used by the FEM solver +!-------------------------------------------------------------------------------------------------- +module FEM_utilities + use, intrinsic :: iso_c_binding + use prec, only: & + pReal, & + pInt + + implicit none + private +#include +!-------------------------------------------------------------------------------------------------- +! + logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill + integer(pInt), public, parameter :: maxFields = 6_pInt + integer(pInt), public :: nActiveFields = 0_pInt + +!-------------------------------------------------------------------------------------------------- +! grid related information information + real(pReal), public :: wgt !< weighting factor 1/Nelems + real(pReal), public :: wgtDof !< weighting factor 1/Nelems + real(pReal), public :: C_volAvg(3,3,3,3) + +!-------------------------------------------------------------------------------------------------- +! output data + PetscViewer, public :: resUnit + Vec, public :: coordinatesVec + Vec, allocatable, public :: homogenizationResultsVec(:), & + crystalliteResultsVec(:,:), & + phaseResultsVec(:,:) + +!-------------------------------------------------------------------------------------------------- +! field labels information + character(len=*), parameter, public :: & + FIELD_MECH_label = 'mechanical', & + FIELD_THERMAL_label = 'thermal', & + FIELD_DAMAGE_label = 'damage', & + FIELD_SOLUTE_label = 'solute', & + FIELD_MGTWIN_label = 'mgtwin' + + enum, bind(c) + enumerator :: FIELD_UNDEFINED_ID, & + FIELD_MECH_ID, & + FIELD_THERMAL_ID, & + FIELD_DAMAGE_ID, & + FIELD_SOLUTE_ID, & + FIELD_MGTWIN_ID + end enum + enum, bind(c) + enumerator :: COMPONENT_UNDEFINED_ID, & + COMPONENT_MECH_X_ID, & + COMPONENT_MECH_Y_ID, & + COMPONENT_MECH_Z_ID, & + COMPONENT_THERMAL_T_ID, & + COMPONENT_DAMAGE_PHI_ID, & + COMPONENT_SOLUTE_CV_ID, & + COMPONENT_SOLUTE_CVPOT_ID, & + COMPONENT_SOLUTE_CH_ID, & + COMPONENT_SOLUTE_CHPOT_ID, & + COMPONENT_SOLUTE_CVaH_ID, & + COMPONENT_SOLUTE_CVaHPOT_ID, & + COMPONENT_MGTWIN_PHI_ID + end enum + +!-------------------------------------------------------------------------------------------------- +! variables controlling debugging + logical, private :: & + debugGeneral, & !< general debugging of FEM solver + debugRotation, & !< also printing out results in lab frame + debugPETSc !< use some in debug defined options for more verbose PETSc solution + +!-------------------------------------------------------------------------------------------------- +! derived types + type, public :: tSolutionState !< return type of solution from FEM solver variants + logical :: converged = .true. + logical :: stagConverged = .true. + logical :: regrid = .false. + integer(pInt) :: iterationsNeeded = 0_pInt + end type tSolutionState + + type, public :: tComponentBC + integer(kind(COMPONENT_UNDEFINED_ID)) :: ID + real(pReal), allocatable :: Value(:) + logical, allocatable :: Mask(:) + end type tComponentBC + + type, public :: tFieldBC + integer(kind(FIELD_UNDEFINED_ID)) :: ID + integer(pInt) :: nComponents = 0_pInt + type(tComponentBC), allocatable :: componentBC(:) + end type tFieldBC + + type, public :: tLoadCase + real(pReal) :: time = 0.0_pReal !< length of increment + integer(pInt) :: incs = 0_pInt, & !< number of increments + outputfrequency = 1_pInt, & !< frequency of result writes + restartfrequency = 0_pInt, & !< frequency of restart writes + logscale = 0_pInt !< linear/logarithmic time inc flag + logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase + integer(pInt), allocatable :: faceID(:) + type(tFieldBC), allocatable :: fieldBC(:) + end type tLoadCase + + type, public :: tFEMInterpolation + integer(pInt) :: n + real(pReal), dimension(:,:) , allocatable :: shapeFunc, shapeDerivReal, geomShapeDerivIso + real(pReal), dimension(:,:,:), allocatable :: shapeDerivIso + end type tFEMInterpolation + + type, public :: tQuadrature + integer(pInt) :: n + real(pReal), dimension(:) , allocatable :: Weights + real(pReal), dimension(:,:), allocatable :: Points + end type tQuadrature + + public :: & + utilities_init, & + utilities_constitutiveResponse, & + utilities_indexBoundaryDofs, & + utilities_projectBCValues, & + utilities_indexActiveSet, & + utilities_destroy, & + FIELD_MECH_ID, & + FIELD_THERMAL_ID, & + FIELD_DAMAGE_ID, & + FIELD_SOLUTE_ID, & + FIELD_MGTWIN_ID, & + COMPONENT_MECH_X_ID, & + COMPONENT_MECH_Y_ID, & + COMPONENT_MECH_Z_ID, & + COMPONENT_THERMAL_T_ID, & + COMPONENT_DAMAGE_PHI_ID, & + COMPONENT_SOLUTE_CV_ID, & + COMPONENT_SOLUTE_CVPOT_ID, & + COMPONENT_SOLUTE_CH_ID, & + COMPONENT_SOLUTE_CHPOT_ID, & + COMPONENT_SOLUTE_CVaH_ID, & + COMPONENT_SOLUTE_CVaHPOT_ID, & + COMPONENT_MGTWIN_PHI_ID + + external :: & + MPI_abort, & + MPI_Allreduce, & + PetscOptionsClear, & + PetscOptionsInsertString, & + PetscObjectSetName, & + VecCreateMPI, & + VecSetFromOptions, & + VecGetSize, & + VecAssemblyBegin, & + VecAssemblyEnd, & + VecView, & + VecDestroy, & + ISCreateGeneral, & + ISDuplicate, & + ISDifference, & + ISGetSize, & + ISLocalToGlobalMappingApplyIS, & + ISDestroy, & + DMGetDimension, & + DMGetLocalToGlobalMapping, & + DMGetLabel, & + DMGetStratumSize, & + DMGetStratumIS, & + DMPlexGetHeightStratum, & + DMGetLabelIdIS, & + DMPlexGetChart, & + DMPlexLabelComplete, & + PetscSectionGetStorageSize, & + PetscSectionGetFieldDof, & + PetscSectionGetFieldOffset, & + PetscViewerHDF5Open, & + PetscViewerHDF5PushGroup, & + PetscViewerHDF5PopGroup, & + PetscViewerDestroy + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates all neccessary fields, sets debug flags +!-------------------------------------------------------------------------------------------------- +subroutine utilities_init() + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) + use DAMASK_interface, only: & + getSolverJobName + use IO, only: & + IO_error, & + IO_warning, & + IO_timeStamp, & + IO_open_file + use numerics, only: & + integrationOrder, & + worldsize, & + worldrank, & + petsc_defaultOptions, & + petsc_options, & + structOrder, & + thermalOrder, & + damageOrder, & + soluteOrder, & + mgtwinOrder + use debug, only: & + debug_level, & + debug_SPECTRAL, & + debug_LEVELBASIC, & + debug_SPECTRALPETSC, & + debug_SPECTRALROTATION + use debug, only: & + PETSCDEBUG + use math ! must use the whole module for use of FFTW + use mesh, only: & + mesh_NcpElemsGlobal, & + mesh_maxNips, & + geomMesh, & + mesh_element + use homogenization, only: & + homogOutput, & + crystalliteOutput, & + phaseOutput + use material, only: & + material_Nhomogenization, & + material_Ncrystallite, & + material_Nphase, & + homogenization_Ngrains, & + homogenization_maxNgrains, & + material_homog, & + material_phase, & + microstructure_crystallite, & + homogenization_name, & + crystallite_name, & + phase_name + + implicit none + + character(len=1024) :: petsc_optionsPhysics, grainStr + integer(pInt) :: dimPlex + integer(pInt) :: headerID = 205_pInt + PetscInt, dimension(:), pointer :: points + PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:), mappingCells(:) + PetscInt :: cellStart, cellEnd, cell, ip, dim, ctr, qPt + PetscInt :: homog, cryst, grain, phase + PetscInt, allocatable :: connectivity(:,:) + Vec :: connectivityVec + PetscScalar, dimension(:), pointer :: results + PetscErrorCode :: ierr + + if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif + +!-------------------------------------------------------------------------------------------------- +! set debugging parameters + debugGeneral = iand(debug_level(debug_SPECTRAL),debug_LEVELBASIC) /= 0 + debugRotation = iand(debug_level(debug_SPECTRAL),debug_SPECTRALROTATION) /= 0 + debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0 + if(debugPETSc) write(6,'(3(/,a),/)') & + ' Initializing PETSc with debug options: ', & + trim(PETScDebug), & + ' add more using the PETSc_Options keyword in numerics.config ' + flush(6) + call PetscOptionsClear(PETSC_NULL_OBJECT,ierr) + CHKERRQ(ierr) + if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(PETSCDEBUG),ierr) + CHKERRQ(ierr) + call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_defaultOptions),ierr) + call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_options),ierr) + CHKERRQ(ierr) + write(petsc_optionsPhysics,'(a,i0)') '-mechFE_petscspace_order ' , structOrder + call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_optionsPhysics),ierr) + CHKERRQ(ierr) + write(petsc_optionsPhysics,'(a,i0)') '-thermalFE_petscspace_order ', thermalOrder + call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_optionsPhysics),ierr) + CHKERRQ(ierr) + write(petsc_optionsPhysics,'(a,i0)') '-damageFE_petscspace_order ' , damageOrder + call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_optionsPhysics),ierr) + CHKERRQ(ierr) + write(petsc_optionsPhysics,'(a,i0)') '-soluteFE_petscspace_order ', soluteOrder + call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_optionsPhysics),ierr) + CHKERRQ(ierr) + write(petsc_optionsPhysics,'(a,i0)') '-mgtwinFE_petscspace_order ', mgtwinOrder + call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_optionsPhysics),ierr) + CHKERRQ(ierr) + + wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal) + + call PetscViewerHDF5Open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.h5', & + FILE_MODE_WRITE, resUnit, ierr); CHKERRQ(ierr) + call PetscViewerHDF5PushGroup(resUnit, '/', ierr); CHKERRQ(ierr) + call DMGetDimension(geomMesh,dimPlex,ierr); CHKERRQ(ierr) + allocate(nEntities(dimPlex+1), source=0) + allocate(nOutputNodes(worldsize), source = 0) + allocate(nOutputCells(worldsize), source = 0) + do dim = 0, dimPlex + call DMGetStratumSize(geomMesh,'depth',dim,nEntities(dim+1),ierr) + CHKERRQ(ierr) + enddo + select case (integrationOrder) + case(1_pInt) + nOutputNodes(worldrank+1) = nEntities(1) + case(2_pInt) + nOutputNodes(worldrank+1) = sum(nEntities) + case default + nOutputNodes(worldrank+1) = mesh_maxNips*nEntities(dimPlex+1) + end select + nOutputCells(worldrank+1) = count(material_homog > 0_pInt) + call MPI_Allreduce(MPI_IN_PLACE,nOutputNodes,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) + call MPI_Allreduce(MPI_IN_PLACE,nOutputCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) + if (worldrank == 0_pInt) then + open(unit=headerID, file=trim(getSolverJobName())//'.header', & + form='FORMATTED', status='REPLACE') + write(headerID, '(a,i0)') 'dimension : ', dimPlex + write(headerID, '(a,i0)') 'number of nodes : ', sum(nOutputNodes) + write(headerID, '(a,i0)') 'number of cells : ', sum(nOutputCells) + endif + + allocate(connectivity(2**dimPlex,nOutputCells(worldrank+1))) + call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr) + CHKERRQ(ierr) + ctr = 0 + select case (integrationOrder) + case(1_pInt) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexGetTransitiveClosure(geomMesh,cell,PETSC_TRUE,points,ierr) + CHKERRQ(ierr) + if (dimPlex == 2) then + connectivity(:,ctr+1) = [points( 9), points(11), points(13), points(13)] - nEntities(dimPlex+1) + ctr = ctr + 1 + else + connectivity(:,ctr+1) = [points(23), points(25), points(27), points(27), & + points(29), points(29), points(29), points(29)] - nEntities(dimPlex+1) + ctr = ctr + 1 + endif + enddo + + case(2_pInt) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexGetTransitiveClosure(geomMesh,cell,PETSC_TRUE,points,ierr) + CHKERRQ(ierr) + if (dimPlex == 2) then + connectivity(:,ctr+1) = [points(9 ), points(3), points(1), points(7)] + connectivity(:,ctr+2) = [points(11), points(5), points(1), points(3)] + connectivity(:,ctr+3) = [points(13), points(7), points(1), points(5)] + ctr = ctr + 3 + else + connectivity(:,ctr+1) = [points(23), points(11), points(3), points(15), points(17), points(5), points(1), points(7)] + connectivity(:,ctr+2) = [points(25), points(13), points(3), points(11), points(19), points(9), points(1), points(5)] + connectivity(:,ctr+3) = [points(27), points(15), points(3), points(13), points(21), points(7), points(1), points(9)] + connectivity(:,ctr+4) = [points(29), points(17), points(7), points(21), points(19), points(5), points(1), points(9)] + ctr = ctr + 4_pInt + endif + enddo + + case default + do cell = cellStart, cellEnd-1; do ip = 0, mesh_maxNips-1 + connectivity(:,ctr+1) = cell*mesh_maxNips + ip + ctr = ctr + 1 + enddo; enddo + + end select + connectivity = connectivity + sum(nOutputNodes(1:worldrank)) + + call VecCreateMPI(PETSC_COMM_WORLD,dimPlex*nOutputNodes(worldrank+1),dimPlex*sum(nOutputNodes), & + coordinatesVec,ierr);CHKERRQ(ierr) + call PetscObjectSetName(coordinatesVec, 'NodalCoordinates',ierr) + call VecSetFromOptions(coordinatesVec, ierr); CHKERRQ(ierr) + + allocate(mappingCells(worldsize), source = 0) + allocate(homogenizationResultsVec(material_Nhomogenization )) + allocate(crystalliteResultsVec (material_Ncrystallite, homogenization_maxNgrains)) + allocate(phaseResultsVec (material_Nphase, homogenization_maxNgrains)) + do homog = 1, material_Nhomogenization + mappingCells = 0_pInt; mappingCells(worldrank+1) = homogOutput(homog)%sizeIpCells + call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) + call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & + homogenizationResultsVec(homog),ierr);CHKERRQ(ierr) + if (sum(mappingCells) > 0) then + call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & + connectivityVec,ierr);CHKERRQ(ierr) + call PetscObjectSetName(connectivityVec,'mapping_'//trim(homogenization_name(homog)),ierr) + CHKERRQ(ierr) + call VecGetArrayF90(connectivityVec,results,ierr); CHKERRQ(ierr) + results = 0.0_pReal; ctr = 1_pInt + do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips + if (material_homog(qPt,cell+1) == homog) then + results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & + shape=[2**dimPlex])) + ctr = ctr + 2**dimPlex + endif + enddo; enddo + call VecRestoreArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) + call VecAssemblyBegin(connectivityVec, ierr); CHKERRQ(ierr) + call VecAssemblyEnd (connectivityVec, ierr); CHKERRQ(ierr) + call VecView(connectivityVec, resUnit, ierr); CHKERRQ(ierr) + call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) + endif + enddo + do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains + mappingCells = 0_pInt + mappingCells(worldrank+1) = crystalliteOutput(cryst,grain)%sizeIpCells + call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) + call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & + crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr) + if (sum(mappingCells) > 0) then + call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & + connectivityVec,ierr);CHKERRQ(ierr) + write(grainStr,'(a,i0)') 'Grain',grain + call PetscObjectSetName(connectivityVec,'mapping_'// & + trim(crystallite_name(cryst))//'_'// & + trim(grainStr),ierr) + CHKERRQ(ierr) + call VecGetArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) + results = 0.0_pReal; ctr = 1_pInt + do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips + if (homogenization_Ngrains (mesh_element(3,cell+1)) >= grain .and. & + microstructure_crystallite(mesh_element(4,cell+1)) == cryst) then + results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & + shape=[2**dimPlex])) + ctr = ctr + 2**dimPlex + endif + enddo; enddo + call VecRestoreArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) + call VecAssemblyBegin(connectivityVec, ierr); CHKERRQ(ierr) + call VecAssemblyEnd (connectivityVec, ierr); CHKERRQ(ierr) + call VecView(connectivityVec, resUnit, ierr); CHKERRQ(ierr) + call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) + endif + enddo; enddo + do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains + mappingCells = 0_pInt + mappingCells(worldrank+1) = phaseOutput(phase,grain)%sizeIpCells + call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) + call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & + phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr) + if (sum(mappingCells) > 0) then + call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & + connectivityVec,ierr);CHKERRQ(ierr) + write(grainStr,'(a,i0)') 'Grain',grain + call PetscObjectSetName(connectivityVec,& + 'mapping_'//trim(phase_name(phase))//'_'// & + trim(grainStr),ierr) + CHKERRQ(ierr) + call VecGetArrayF90(connectivityVec, results, ierr) + CHKERRQ(ierr) + results = 0.0_pReal; ctr = 1_pInt + do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips + if (material_phase(grain,qPt,cell+1) == phase) then + results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & + shape=[2**dimPlex])) + ctr = ctr + 2**dimPlex + endif + enddo; enddo + call VecRestoreArrayF90(connectivityVec, results, ierr) + CHKERRQ(ierr) + call VecAssemblyBegin(connectivityVec, ierr);CHKERRQ(ierr) + call VecAssemblyEnd (connectivityVec, ierr);CHKERRQ(ierr) + call VecView(connectivityVec, resUnit, ierr);CHKERRQ(ierr) + call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) + endif + enddo; enddo + if (worldrank == 0_pInt) then + do homog = 1, material_Nhomogenization + call VecGetSize(homogenizationResultsVec(homog),mappingCells(1),ierr) + CHKERRQ(ierr) + if (mappingCells(1) > 0) & + write(headerID, '(a,i0)') 'number of homog_'// & + trim(homogenization_name(homog))//'_'// & + 'cells : ', mappingCells(1) + enddo + do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains + call VecGetSize(crystalliteResultsVec(cryst,grain),mappingCells(1),ierr) + CHKERRQ(ierr) + write(grainStr,'(a,i0)') 'Grain',grain + if (mappingCells(1) > 0) & + write(headerID, '(a,i0)') 'number of cryst_'// & + trim(crystallite_name(cryst))//'_'// & + trim(grainStr)//'_'// & + 'cells : ', mappingCells(1) + enddo; enddo + do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains + call VecGetSize(phaseResultsVec(phase,grain),mappingCells(1),ierr) + CHKERRQ(ierr) + write(grainStr,'(a,i0)') 'Grain',grain + if (mappingCells(1) > 0) & + write(headerID, '(a,i0)') 'number of phase_'// & + trim(phase_name(phase))//'_'//trim(grainStr)//'_'// & + 'cells : ', mappingCells(1) + enddo; enddo + close(headerID) + endif + +end subroutine utilities_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates constitutive response +!-------------------------------------------------------------------------------------------------- +subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) + use debug, only: & + debug_reset, & + debug_info + use numerics, only: & + worldrank + use math, only: & + math_transpose33, & + math_rotate_forward33, & + math_det33 + use FEsolving, only: & + restartWrite + use CPFEM2, only: & + CPFEM_general + use homogenization, only: & + materialpoint_F0, & + materialpoint_F, & + materialpoint_P, & + materialpoint_dPdF + use mesh, only: & + mesh_NcpElems + + implicit none + real(pReal), intent(in) :: timeinc !< loading time + logical, intent(in) :: forwardData !< age results + + real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress + + logical :: & + age + + integer(pInt) :: & + j + real(pReal) :: defgradDetMin, defgradDetMax, defgradDet + PetscErrorCode :: ierr + + if (worldrank == 0) & + write(6,'(/,a)') ' ... evaluating constitutive response ......................................' + + age = .False. + if (forwardData) then ! aging results + age = .True. + endif + if (cutBack) then ! restore saved variables + age = .False. + endif + call debug_reset() + +!-------------------------------------------------------------------------------------------------- +! calculate bounds of det(F) and report + if(debugGeneral) then + defgradDetMax = -huge(1.0_pReal) + defgradDetMin = +huge(1.0_pReal) + do j = 1_pInt, mesh_NcpElems + defgradDet = math_det33(materialpoint_F(1:3,1:3,1,j)) + defgradDetMax = max(defgradDetMax,defgradDet) + defgradDetMin = min(defgradDetMin,defgradDet) + end do + write(6,'(a,1x,es11.4)') ' max determinant of deformation =', defgradDetMax + write(6,'(a,1x,es11.4)') ' min determinant of deformation =', defgradDetMin + flush(6) + endif + + call CPFEM_general(age,timeinc) + + call debug_info() + + restartWrite = .false. ! reset restartWrite status + cutBack = .false. ! reset cutBack status + + P_av = sum(sum(materialpoint_P,dim=4),dim=3) * wgt ! average of P + C_volAvg = sum(sum(materialpoint_dPdF,dim=6),dim=5) * wgt + call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) + call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD, ierr) + +end subroutine utilities_constitutiveResponse + +!-------------------------------------------------------------------------------------------------- +!> @brief Create index sets of boundary dofs (in local and global numbering) +!-------------------------------------------------------------------------------------------------- +subroutine utilities_indexBoundaryDofs(dm_local,nFaceSets,numFields,local2global,section,localIS,globalIS) + + implicit none + + DM :: dm_local + ISLocalToGlobalMapping :: local2global + PetscSection :: section + PetscInt :: nFaceSets, numFields, nDof + IS, dimension(nFaceSets,numFields) :: localIS, globalIS + PetscInt :: field, faceSet, point, dof, offset + PetscInt :: localSize, storageSize, ISSize + PetscInt, dimension(:) , allocatable :: localIndices + IS :: faceSetIS, BC_IS, dummyIS + PetscInt, dimension(:) , pointer :: pFaceSets, pBCvertex, pBCvertexlc + DMLabel :: BCLabel + PetscErrorCode :: ierr + + call DMGetLabel(dm_local,'Face Sets',BCLabel,ierr); CHKERRQ(ierr) + call DMPlexLabelComplete(dm_local,BCLabel,ierr); CHKERRQ(ierr) + call PetscSectionGetStorageSize(section,storageSize,ierr); CHKERRQ(ierr) + call DMGetLabelIdIS(dm_local,'Face Sets',faceSetIS,ierr); CHKERRQ(ierr) + call ISGetIndicesF90(faceSetIS,pFaceSets,ierr); CHKERRQ(ierr) + allocate(localIndices (storageSize)) + do faceSet = 1, nFaceSets + call DMGetStratumSize(dm_local,'Face Sets',pFaceSets(faceSet),ISSize,ierr) + CHKERRQ(ierr) + call DMGetStratumIS(dm_local,'Face Sets',pFaceSets(faceSet),BC_IS,ierr) + CHKERRQ(ierr) + if (ISSize > 0) call ISGetIndicesF90(BC_IS,pBCvertex,ierr) + do field = 1, numFields + localSize = 0 + do point = 1, ISSize + call PetscSectionGetFieldDof(section,pBCvertex(point),field-1,nDof,ierr) + CHKERRQ(ierr) + call PetscSectionGetFieldOffset(section,pBCvertex(point),field-1,offset,ierr) + CHKERRQ(ierr) + do dof = 1, nDof + localSize = localSize + 1 + localIndices(localSize) = offset + dof - 1 + enddo + enddo + call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES, & + localIS(faceSet,field),ierr) + CHKERRQ(ierr) + call ISLocalToGlobalMappingApplyIS(local2global,localIS(faceSet,field), & + globalIS(faceSet,field),ierr) + CHKERRQ(ierr) + enddo + if (ISSize > 0) call ISRestoreIndicesF90(BC_IS,pBCvertex,ierr) + call ISDestroy(BC_IS,ierr); CHKERRQ(ierr) + enddo + call ISRestoreIndicesF90(faceSetIS,pFaceSets,ierr); CHKERRQ(ierr) + call ISDestroy(faceSetIS,ierr); CHKERRQ(ierr) + + do faceSet = 1, nFaceSets; do field = 1, numFields + call ISGetSize(globalIS(faceSet,field),ISSize,ierr); CHKERRQ(ierr) + if (ISSize > 0) then + call ISGetIndicesF90(localIS(faceSet,field),pBCvertexlc,ierr); CHKERRQ(ierr) + call ISGetIndicesF90(globalIS(faceSet,field),pBCvertex,ierr); CHKERRQ(ierr) + endif + localSize = 0 + do point = 1, ISSize + if (pBCvertex(point) >= 0) then + localSize = localSize + 1 + localIndices(localSize) = pBCvertexlc(point) + endif + enddo + if (ISSize > 0) then + call ISRestoreIndicesF90(localIS(faceSet,field),pBCvertexlc,ierr); CHKERRQ(ierr) + call ISRestoreIndicesF90(globalIS(faceSet,field),pBCvertex,ierr); CHKERRQ(ierr) + endif + call ISDestroy(globalIS(faceSet,field),ierr); CHKERRQ(ierr) + call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES, & + globalIS(faceSet,field),ierr) + CHKERRQ(ierr) + if (ISSize > 0) then + call ISDuplicate(localIS(faceSet,field),dummyIS,ierr); CHKERRQ(ierr) + call ISDestroy(localIS(faceSet,field),ierr); CHKERRQ(ierr) + call ISDifference(dummyIS,globalIS(faceSet,field),localIS(faceSet,field),ierr) + CHKERRQ(ierr) + call ISDestroy(dummyIS,ierr); CHKERRQ(ierr) + endif + enddo; enddo + deallocate(localIndices) + +end subroutine utilities_indexBoundaryDofs + +!-------------------------------------------------------------------------------------------------- +!> @brief Project BC values to local vector +!-------------------------------------------------------------------------------------------------- +subroutine utilities_projectBCValues(localVec,section,field,comp,bcPointsIS,BCValue,BCDotValue,timeinc) + + implicit none + + Vec :: localVec + PetscInt :: field, comp, nBcPoints, point, dof, numDof, numComp, offset + PetscSection :: section + IS :: bcPointsIS + PetscInt, pointer :: bcPoints(:) + PetscScalar, pointer :: localArray(:) + PetscScalar :: BCValue,BCDotValue,timeinc + PetscErrorCode :: ierr + + call PetscSectionGetFieldComponents(section,field,numComp,ierr); CHKERRQ(ierr) + call ISGetSize(bcPointsIS,nBcPoints,ierr); CHKERRQ(ierr) + if (nBcPoints > 0) call ISGetIndicesF90(bcPointsIS,bcPoints,ierr) + call VecGetArrayF90(localVec,localArray,ierr); CHKERRQ(ierr) + do point = 1, nBcPoints + call PetscSectionGetFieldDof(section,bcPoints(point),field,numDof,ierr) + CHKERRQ(ierr) + call PetscSectionGetFieldOffset(section,bcPoints(point),field,offset,ierr) + CHKERRQ(ierr) + do dof = offset+comp+1, offset+numDof, numComp + localArray(dof) = localArray(dof) + BCValue + BCDotValue*timeinc + enddo + enddo + call VecRestoreArrayF90(localVec,localArray,ierr); CHKERRQ(ierr) + call VecAssemblyBegin(localVec, ierr); CHKERRQ(ierr) + call VecAssemblyEnd (localVec, ierr); CHKERRQ(ierr) + if (nBcPoints > 0) call ISRestoreIndicesF90(bcPointsIS,bcPoints,ierr) + +end subroutine utilities_projectBCValues + +!-------------------------------------------------------------------------------------------------- +!> @brief Create index sets of boundary dofs (in local and global numbering) +!-------------------------------------------------------------------------------------------------- +subroutine utilities_indexActiveSet(field,section,x_local,f_local,localIS,globalIS) + use mesh, only: & + geomMesh + + implicit none + + ISLocalToGlobalMapping :: local2global + PetscSection :: section + Vec :: x_local, f_local + PetscInt :: field + IS :: localIS, globalIS, dummyIS + PetscScalar, dimension(:) , pointer :: x_scal, f_scal + PetscInt :: ISSize + PetscInt :: chart, chartStart, chartEnd, nDof, dof, offset + PetscInt :: localSize + PetscInt, dimension(:) , allocatable :: localIndices + PetscInt, dimension(:) , pointer :: pBCvertex, pBCvertexlc + PetscErrorCode :: ierr + + call DMGetLocalToGlobalMapping(geomMesh,local2global,ierr) + CHKERRQ(ierr) + call DMPlexGetChart(geomMesh,chartStart,chartEnd,ierr) + CHKERRQ(ierr) + call VecGetArrayF90(x_local,x_scal,ierr); CHKERRQ(ierr) + call VecGetArrayF90(f_local,f_scal,ierr); CHKERRQ(ierr) + localSize = 0 + do chart = chartStart, chartEnd-1 + call PetscSectionGetFieldDof(section,chart,field-1,nDof,ierr); CHKERRQ(ierr) + call PetscSectionGetFieldOffset(section,chart,field-1,offset,ierr); CHKERRQ(ierr) + do dof = offset+1, offset+nDof + if (((x_scal(dof) < 1.0e-8) .and. (f_scal(dof) > 0.0)) .or. & + ((x_scal(dof) > 1.0 - 1.0e-8) .and. (f_scal(dof) < 0.0))) localSize = localSize + 1 + enddo + enddo + allocate(localIndices(localSize)) + localSize = 0 + do chart = chartStart, chartEnd-1 + call PetscSectionGetFieldDof(section,chart,field-1,nDof,ierr); CHKERRQ(ierr) + call PetscSectionGetFieldOffset(section,chart,field-1,offset,ierr); CHKERRQ(ierr) + do dof = offset+1, offset+nDof + if (((x_scal(dof) < 1.0e-8) .and. (f_scal(dof) > 0.0)) .or. & + ((x_scal(dof) > 1.0 - 1.0e-8) .and. (f_scal(dof) < 0.0))) then + localSize = localSize + 1 + localIndices(localSize) = dof-1 + endif + enddo + enddo + call VecRestoreArrayF90(x_local,x_scal,ierr); CHKERRQ(ierr) + call VecRestoreArrayF90(f_local,f_scal,ierr); CHKERRQ(ierr) + call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES,localIS,ierr) + CHKERRQ(ierr) + call ISLocalToGlobalMappingApplyIS(local2global,localIS,globalIS,ierr) + CHKERRQ(ierr) + call ISGetSize(globalIS,ISSize,ierr); CHKERRQ(ierr) + if (ISSize > 0) then + call ISGetIndicesF90(localIS,pBCvertexlc,ierr); CHKERRQ(ierr) + call ISGetIndicesF90(globalIS,pBCvertex,ierr); CHKERRQ(ierr) + endif + localSize = 0 + do chart = 1, ISSize + if (pBCvertex(chart) >= 0) then + localSize = localSize + 1 + localIndices(localSize) = pBCvertexlc(chart) + endif + enddo + if (ISSize > 0) then + call ISRestoreIndicesF90(localIS,pBCvertexlc,ierr); CHKERRQ(ierr) + call ISRestoreIndicesF90(globalIS,pBCvertex,ierr); CHKERRQ(ierr) + endif + call ISDestroy(globalIS,ierr); CHKERRQ(ierr) + call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES,globalIS,ierr) + CHKERRQ(ierr) + if (ISSize > 0) then + call ISDuplicate(localIS,dummyIS,ierr); CHKERRQ(ierr) + call ISDestroy(localIS,ierr); CHKERRQ(ierr) + call ISDifference(dummyIS,globalIS,localIS,ierr) + CHKERRQ(ierr) + call ISDestroy(dummyIS,ierr); CHKERRQ(ierr) + endif + deallocate(localIndices) + +end subroutine utilities_indexActiveSet + +!-------------------------------------------------------------------------------------------------- +!> @brief cleans up +!-------------------------------------------------------------------------------------------------- +subroutine utilities_destroy() + use material, only: & + material_Nhomogenization, & + material_Ncrystallite, & + material_Nphase, & + homogenization_Ngrains + + implicit none + PetscInt :: homog, cryst, grain, phase + PetscErrorCode :: ierr + + call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr) + call VecDestroy(coordinatesVec,ierr); CHKERRQ(ierr) + do homog = 1, material_Nhomogenization + call VecDestroy(homogenizationResultsVec(homog),ierr);CHKERRQ(ierr) + do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_Ngrains(homog) + call VecDestroy(crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr) + enddo; enddo + do phase = 1, material_Nphase; do grain = 1, homogenization_Ngrains(homog) + call VecDestroy(phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr) + enddo; enddo + enddo + call PetscViewerDestroy(resUnit, ierr); CHKERRQ(ierr) + +end subroutine utilities_destroy + + +end module FEM_utilities diff --git a/src/FEM_zoo.f90 b/src/FEM_zoo.f90 new file mode 100644 index 000000000..2c4250098 --- /dev/null +++ b/src/FEM_zoo.f90 @@ -0,0 +1,356 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Interpolation data used by the FEM solver +!-------------------------------------------------------------------------------------------------- +module FEM_Zoo + use prec, only: pReal, pInt, p_vec + + implicit none +#include + private + integer(pInt), parameter, public:: & + maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary) + real(pReal), dimension(2,3), private, protected :: & + triangle = reshape([-1.0_pReal, -1.0_pReal, & + 1.0_pReal, -1.0_pReal, & + -1.0_pReal, 1.0_pReal], shape=[2,3]) + real(pReal), dimension(3,4), private, protected :: & + tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, & + 1.0_pReal, -1.0_pReal, -1.0_pReal, & + -1.0_pReal, 1.0_pReal, -1.0_pReal, & + -1.0_pReal, -1.0_pReal, 1.0_pReal], shape=[3,4]) + integer(pInt), dimension(3,maxOrder), public, protected :: & + FEM_Zoo_nQuadrature !< number of quadrature points for a given spatial dimension(1-3) and interpolation order(1-maxOrder) + type(p_vec), dimension(3,maxOrder), public, protected :: & + FEM_Zoo_QuadratureWeights, & !< quadrature weights for each quadrature rule + FEM_Zoo_QuadraturePoints !< quadrature point coordinates (in simplical system) for each quadrature rule + + public :: & + FEM_Zoo_init + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes FEM interpolation data +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_init + use, intrinsic :: iso_fortran_env + use IO, only: & + IO_timeStamp + use math, only: & + math_binomial + + implicit none + PetscInt :: worldrank + PetscErrorCode :: ierr + external :: & + MPI_Comm_rank, & + MPI_abort + + call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) + if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- FEM_Zoo init -+>>>' + write(6,'(a)') ' $Id: FEM_Zoo.f90 4354 2015-08-04 15:04:53Z MPIE\p.shanthraj $' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif +!-------------------------------------------------------------------------------------------------- +! 2D linear + FEM_Zoo_nQuadrature(2,1) = 1 + allocate(FEM_Zoo_QuadratureWeights(2,1)%p(1)) + allocate(FEM_Zoo_QuadraturePoints (2,1)%p(2)) + FEM_Zoo_QuadratureWeights(2,1)%p(1) = 1.0_pReal + call FEM_Zoo_permutationStar3([1.0_pReal/3.0_pReal], & + FEM_Zoo_QuadraturePoints(2,1)%p(1:2)) + +!-------------------------------------------------------------------------------------------------- +! 2D quadratic + FEM_Zoo_nQuadrature(2,2) = 3 + allocate(FEM_Zoo_QuadratureWeights(2,2)%p(3)) + allocate(FEM_Zoo_QuadraturePoints (2,2)%p(6)) + FEM_Zoo_QuadratureWeights(2,2)%p(1:3) = 1.0_pReal/3.0_pReal + call FEM_Zoo_permutationStar21([1.0_pReal/6.0_pReal], & + FEM_Zoo_QuadraturePoints(2,2)%p(1:6)) + +!-------------------------------------------------------------------------------------------------- +! 2D cubic + FEM_Zoo_nQuadrature(2,3) = 6 + allocate(FEM_Zoo_QuadratureWeights(2,3)%p(6 )) + allocate(FEM_Zoo_QuadraturePoints (2,3)%p(12)) + FEM_Zoo_QuadratureWeights(2,3)%p(1:3) = 0.22338158967801146570_pReal + call FEM_Zoo_permutationStar21([0.44594849091596488632_pReal], & + FEM_Zoo_QuadraturePoints(2,3)%p(1:6)) + FEM_Zoo_QuadratureWeights(2,3)%p(4:6) = 0.10995174365532186764_pReal + call FEM_Zoo_permutationStar21([0.091576213509770743460_pReal], & + FEM_Zoo_QuadraturePoints(2,3)%p(7:12)) + +!-------------------------------------------------------------------------------------------------- +! 2D quartic + FEM_Zoo_nQuadrature(2,4) = 12 + allocate(FEM_Zoo_QuadratureWeights(2,4)%p(12)) + allocate(FEM_Zoo_QuadraturePoints (2,4)%p(24)) + FEM_Zoo_QuadratureWeights(2,4)%p(1:3) = 0.11678627572638_pReal + call FEM_Zoo_permutationStar21([0.24928674517091_pReal], & + FEM_Zoo_QuadraturePoints(2,4)%p(1:6)) + FEM_Zoo_QuadratureWeights(2,4)%p(4:6) = 0.05084490637021_pReal + call FEM_Zoo_permutationStar21([0.06308901449150_pReal], & + FEM_Zoo_QuadraturePoints(2,4)%p(7:12)) + FEM_Zoo_QuadratureWeights(2,4)%p(7:12) = 0.08285107561837_pReal + call FEM_Zoo_permutationStar111([0.31035245103378_pReal, 0.63650249912140_pReal], & + FEM_Zoo_QuadraturePoints(2,4)%p(13:24)) + +!-------------------------------------------------------------------------------------------------- +! 2D order 5 + FEM_Zoo_nQuadrature(2,5) = 16 + allocate(FEM_Zoo_QuadratureWeights(2,5)%p(16)) + allocate(FEM_Zoo_QuadraturePoints (2,5)%p(32)) + FEM_Zoo_QuadratureWeights(2,5)%p(1 ) = 0.14431560767779_pReal + call FEM_Zoo_permutationStar3([0.33333333333333_pReal], & + FEM_Zoo_QuadraturePoints(2,5)%p(1:2)) + FEM_Zoo_QuadratureWeights(2,5)%p(2:4) = 0.09509163426728_pReal + call FEM_Zoo_permutationStar21([0.45929258829272_pReal], & + FEM_Zoo_QuadraturePoints(2,5)%p(3:8)) + FEM_Zoo_QuadratureWeights(2,5)%p(5:7) = 0.10321737053472_pReal + call FEM_Zoo_permutationStar21([0.17056930775176_pReal], & + FEM_Zoo_QuadraturePoints(2,5)%p(9:14)) + FEM_Zoo_QuadratureWeights(2,5)%p(8:10) = 0.03245849762320_pReal + call FEM_Zoo_permutationStar21([0.05054722831703_pReal], & + FEM_Zoo_QuadraturePoints(2,5)%p(15:20)) + FEM_Zoo_QuadratureWeights(2,5)%p(11:16) = 0.02723031417443_pReal + call FEM_Zoo_permutationStar111([0.26311282963464_pReal, 0.72849239295540_pReal], & + FEM_Zoo_QuadraturePoints(2,5)%p(21:32)) + +!-------------------------------------------------------------------------------------------------- +! 3D linear + FEM_Zoo_nQuadrature(3,1) = 1 + allocate(FEM_Zoo_QuadratureWeights(3,1)%p(1)) + allocate(FEM_Zoo_QuadraturePoints (3,1)%p(3)) + FEM_Zoo_QuadratureWeights(3,1)%p(1) = 1.0_pReal + call FEM_Zoo_permutationStar4([0.25_pReal], & + FEM_Zoo_QuadraturePoints(3,1)%p(1:3)) + +!-------------------------------------------------------------------------------------------------- +! 3D quadratic + FEM_Zoo_nQuadrature(3,2) = 4 + allocate(FEM_Zoo_QuadratureWeights(3,2)%p(4 )) + allocate(FEM_Zoo_QuadraturePoints (3,2)%p(12)) + FEM_Zoo_QuadratureWeights(3,2)%p(1:4) = 0.25_pReal + call FEM_Zoo_permutationStar31([0.13819660112501051518_pReal], & + FEM_Zoo_QuadraturePoints(3,2)%p(1:12)) + +!-------------------------------------------------------------------------------------------------- +! 3D cubic + FEM_Zoo_nQuadrature(3,3) = 14 + allocate(FEM_Zoo_QuadratureWeights(3,3)%p(14)) + allocate(FEM_Zoo_QuadraturePoints (3,3)%p(42)) + FEM_Zoo_QuadratureWeights(3,3)%p(1:4) = 0.073493043116361949544_pReal + call FEM_Zoo_permutationStar31([0.092735250310891226402_pReal], & + FEM_Zoo_QuadraturePoints(3,3)%p(1:12)) + FEM_Zoo_QuadratureWeights(3,3)%p(5:8) = 0.11268792571801585080_pReal + call FEM_Zoo_permutationStar31([0.31088591926330060980_pReal], & + FEM_Zoo_QuadraturePoints(3,3)%p(13:24)) + FEM_Zoo_QuadratureWeights(3,3)%p(9:14) = 0.042546020777081466438_pReal + call FEM_Zoo_permutationStar22([0.045503704125649649492_pReal], & + FEM_Zoo_QuadraturePoints(3,3)%p(25:42)) + +!-------------------------------------------------------------------------------------------------- +! 3D quartic + FEM_Zoo_nQuadrature(3,4) = 35 + allocate(FEM_Zoo_QuadratureWeights(3,4)%p(35)) + allocate(FEM_Zoo_QuadraturePoints (3,4)%p(105)) + FEM_Zoo_QuadratureWeights(3,4)%p(1:4) = 0.0021900463965388_pReal + call FEM_Zoo_permutationStar31([0.0267367755543735_pReal], & + FEM_Zoo_QuadraturePoints(3,4)%p(1:12)) + FEM_Zoo_QuadratureWeights(3,4)%p(5:16) = 0.0143395670177665_pReal + call FEM_Zoo_permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal], & + FEM_Zoo_QuadraturePoints(3,4)%p(13:48)) + FEM_Zoo_QuadratureWeights(3,4)%p(17:22) = 0.0250305395686746_pReal + call FEM_Zoo_permutationStar22([0.4547545999844830_pReal], & + FEM_Zoo_QuadraturePoints(3,4)%p(49:66)) + FEM_Zoo_QuadratureWeights(3,4)%p(23:34) = 0.0479839333057554_pReal + call FEM_Zoo_permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal], & + FEM_Zoo_QuadraturePoints(3,4)%p(67:102)) + FEM_Zoo_QuadratureWeights(3,4)%p(35) = 0.0931745731195340_pReal + call FEM_Zoo_permutationStar4([0.25_pReal], & + FEM_Zoo_QuadraturePoints(3,4)%p(103:105)) +!-------------------------------------------------------------------------------------------------- +! 3D quintic + FEM_Zoo_nQuadrature(3,5) = 56 + allocate(FEM_Zoo_QuadratureWeights(3,5)%p(56)) + allocate(FEM_Zoo_QuadraturePoints (3,5)%p(168)) + FEM_Zoo_QuadratureWeights(3,5)%p(1:4) = 0.0010373112336140_pReal + call FEM_Zoo_permutationStar31([0.0149520651530592_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(1:12)) + FEM_Zoo_QuadratureWeights(3,5)%p(5:16) = 0.0096016645399480_pReal + call FEM_Zoo_permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(13:48)) + FEM_Zoo_QuadratureWeights(3,5)%p(17:28) = 0.0164493976798232_pReal + call FEM_Zoo_permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(49:84)) + FEM_Zoo_QuadratureWeights(3,5)%p(29:40) = 0.0153747766513310_pReal + call FEM_Zoo_permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(85:120)) + FEM_Zoo_QuadratureWeights(3,5)%p(41:52) = 0.0293520118375230_pReal + call FEM_Zoo_permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(121:156)) + FEM_Zoo_QuadratureWeights(3,5)%p(53:56) = 0.0366291366405108_pReal + call FEM_Zoo_permutationStar31([0.1344783347929940_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(157:168)) + +end subroutine FEM_Zoo_init + +!-------------------------------------------------------------------------------------------------- +!> @brief star 3 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar3(point,qPt) + + implicit none + real(pReal) :: point(1), qPt(2,1), temp(3,1) + + temp(:,1) = [point(1), point(1), point(1)] + qPt = matmul(triangle, temp) + +end subroutine FEM_Zoo_permutationStar3 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 21 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar21(point,qPt) + + implicit none + real(pReal) :: point(1), qPt(2,3), temp(3,3) + + temp(:,1) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1)] + temp(:,2) = [point(1), 1.0_pReal - 2.0_pReal*point(1), point(1)] + temp(:,3) = [1.0_pReal - 2.0_pReal*point(1), point(1), point(1)] + qPt = matmul(triangle, temp) + +end subroutine FEM_Zoo_permutationStar21 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 111 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar111(point,qPt) + + implicit none + real(pReal) :: point(2), qPt(2,6), temp(3,6) + + temp(:,1) = [point(1), point(2), 1.0_pReal - point(1) - point(2)] + temp(:,2) = [point(1), 1.0_pReal - point(1) - point(2), point(2)] + temp(:,4) = [point(2), 1.0_pReal - point(1) - point(2), point(1)] + temp(:,5) = [1.0_pReal - point(1) - point(2), point(2), point(1)] + temp(:,6) = [1.0_pReal - point(1) - point(2), point(1), point(2)] + qPt = matmul(triangle, temp) + +end subroutine FEM_Zoo_permutationStar111 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 4 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar4(point,qPt) + + implicit none + real(pReal) :: point(1), qPt(3,1), temp(4,1) + + temp(:,1) = [point(1), point(1), point(1), point(1)] + qPt = matmul(tetrahedron, temp) + +end subroutine FEM_Zoo_permutationStar4 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 31 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar31(point,qPt) + + implicit none + real(pReal) :: point(1), qPt(3,4), temp(4,4) + + temp(:,1) = [point(1), point(1), point(1), 1.0_pReal - 3.0_pReal*point(1)] + temp(:,2) = [point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), point(1)] + temp(:,3) = [point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), point(1)] + temp(:,4) = [1.0_pReal - 3.0_pReal*point(1), point(1), point(1), point(1)] + qPt = matmul(tetrahedron, temp) + +end subroutine FEM_Zoo_permutationStar31 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 22 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar22(point,qPt) + + implicit none + real(pReal) :: point(1), qPt(3,6), temp(4,6) + + temp(:,1) = [point(1), point(1), 0.5_pReal - point(1), 0.5_pReal - point(1)] + temp(:,2) = [point(1), 0.5_pReal - point(1), point(1), 0.5_pReal - point(1)] + temp(:,3) = [0.5_pReal - point(1), point(1), point(1), 0.5_pReal - point(1)] + temp(:,4) = [0.5_pReal - point(1), point(1), 0.5_pReal - point(1), point(1)] + temp(:,5) = [0.5_pReal - point(1), 0.5_pReal - point(1), point(1), point(1)] + temp(:,6) = [point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), point(1)] + qPt = matmul(tetrahedron, temp) + +end subroutine FEM_Zoo_permutationStar22 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 211 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar211(point,qPt) + + implicit none + real(pReal) :: point(2), qPt(3,12), temp(4,12) + + temp(:,1 ) = [point(1), point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2)] + temp(:,2 ) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2)] + temp(:,3 ) = [point(1), point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)] + temp(:,4 ) = [point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)] + temp(:,5 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2)] + temp(:,6 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1)] + temp(:,7 ) = [point(2), point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)] + temp(:,8 ) = [point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)] + temp(:,9 ) = [point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1)] + temp(:,10) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), point(2)] + temp(:,11) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), point(1)] + temp(:,12) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), point(1)] + qPt = matmul(tetrahedron, temp) + +end subroutine FEM_Zoo_permutationStar211 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 1111 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar1111(point,qPt) + + implicit none + real(pReal) :: point(3), qPt(3,24), temp(4,24) + + temp(:,1 ) = [point(1), point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,2 ) = [point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3)] + temp(:,3 ) = [point(1), point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,4 ) = [point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2)] + temp(:,5 ) = [point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(3)] + temp(:,6 ) = [point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(2)] + temp(:,7 ) = [point(2), point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,8 ) = [point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3)] + temp(:,9 ) = [point(2), point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,10) = [point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1)] + temp(:,11) = [point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(3)] + temp(:,12) = [point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(1)] + temp(:,13) = [point(3), point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,14) = [point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2)] + temp(:,15) = [point(3), point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,16) = [point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1)] + temp(:,17) = [point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(2)] + temp(:,18) = [point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(1)] + temp(:,19) = [1.0_pReal - point(1) - point(2)- point(3), point(1), point(2), point(3)] + temp(:,20) = [1.0_pReal - point(1) - point(2)- point(3), point(1), point(3), point(2)] + temp(:,21) = [1.0_pReal - point(1) - point(2)- point(3), point(2), point(1), point(3)] + temp(:,22) = [1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), point(1)] + temp(:,23) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), point(2)] + temp(:,24) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), point(1)] + qPt = matmul(tetrahedron, temp) + +end subroutine FEM_Zoo_permutationStar1111 + + +end module FEM_Zoo From d4bcfae82b575e54b457bccf423a5caf02983ede Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 17 Aug 2018 11:23:24 +0200 Subject: [PATCH 116/208] WIP: adopting to PETSc 3.9.x and modifications in development branch --- src/CMakeLists.txt | 9 +- src/CPFEM2.f90 | 6 +- src/FEM_interface.f90 | 2 +- src/FEM_mech.f90 | 2 +- src/FEM_utilities.f90 | 363 ++++++++++++++------------------- src/FEM_zoo.f90 | 22 +- src/homogenization.f90 | 112 ----------- src/meshFEM.f90 | 444 +++++++++++++++++++++++++++++++++++++++++ 8 files changed, 614 insertions(+), 346 deletions(-) mode change 100755 => 100644 src/FEM_mech.f90 create mode 100644 src/meshFEM.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9418cd56d..caaf0b893 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -57,7 +57,7 @@ if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_dependencies(MESH DAMASK_MATH) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") - add_library(FEZoo OBJECT "FEZoo.f90") + add_library(FEZoo OBJECT "FEM_zoo.f90") add_dependencies(FEZoo DAMASK_MATH) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "meshFEM.f90") @@ -186,14 +186,9 @@ elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_dependencies(FEM_UTILITIES DAMASK_CPFE) add_library(FEM_SOLVER OBJECT - "FEM_hydrogenflux.f90" - "FEM_porosity.f90" - "FEM_vacancyflux.f90" - "FEM_damage.f90" - "FEM_thermal.f90" "FEM_mech.f90") add_dependencies(FEM_SOLVER FEM_UTILITIES) - add_executable(DAMASK_FEM "DAMASK_FEM_driver.f90") + add_executable(DAMASK_FEM "DAMASK_FEM.f90") add_dependencies(DAMASK_FEM FEM_SOLVER) endif() diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index c66aa4089..9f75bf8c6 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -50,8 +50,8 @@ subroutine CPFEM_initAll(el,ip) IO_init use DAMASK_interface #ifdef FEM - use FEZoo, only: & - FEZoo_init + use FEM_Zoo, only: & + FEM_Zoo_init #endif implicit none @@ -62,7 +62,7 @@ subroutine CPFEM_initAll(el,ip) call prec_init call IO_init #ifdef FEM - call FEZoo_init + call FEM_Zoo_init #endif call numerics_init call debug_init diff --git a/src/FEM_interface.f90 b/src/FEM_interface.f90 index 4a369dd9c..0363ffdaa 100644 --- a/src/FEM_interface.f90 +++ b/src/FEM_interface.f90 @@ -210,7 +210,7 @@ subroutine DAMASK_interface_init() write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) - if (SpectralRestartInc > 0_pInt) & + if (FEMRestartInc > 0_pInt) & write(6,'(a,i6.6)') ' Restart from increment: ', FEMRestartInc write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile diff --git a/src/FEM_mech.f90 b/src/FEM_mech.f90 old mode 100755 new mode 100644 index aa967bec5..6cf47980e --- a/src/FEM_mech.f90 +++ b/src/FEM_mech.f90 @@ -23,7 +23,7 @@ module FEM_mech implicit none private -#include +#include !-------------------------------------------------------------------------------------------------- ! derived types diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index 621a32508..e16047da6 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -3,14 +3,16 @@ !> @brief Utilities used by the FEM solver !-------------------------------------------------------------------------------------------------- module FEM_utilities - use, intrinsic :: iso_c_binding - use prec, only: & - pReal, & - pInt +#include +#include + use prec, only: pReal, pInt + +use PETScdmda +use PETScis implicit none private -#include +#include !-------------------------------------------------------------------------------------------------- ! logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill @@ -141,36 +143,13 @@ module FEM_utilities COMPONENT_MGTWIN_PHI_ID external :: & - MPI_abort, & MPI_Allreduce, & - PetscOptionsClear, & PetscOptionsInsertString, & PetscObjectSetName, & - VecCreateMPI, & - VecSetFromOptions, & - VecGetSize, & - VecAssemblyBegin, & - VecAssemblyEnd, & - VecView, & - VecDestroy, & - ISCreateGeneral, & - ISDuplicate, & - ISDifference, & - ISGetSize, & - ISLocalToGlobalMappingApplyIS, & - ISDestroy, & - DMGetDimension, & - DMGetLocalToGlobalMapping, & - DMGetLabel, & - DMGetStratumSize, & - DMGetStratumIS, & DMPlexGetHeightStratum, & DMGetLabelIdIS, & DMPlexGetChart, & DMPlexLabelComplete, & - PetscSectionGetStorageSize, & - PetscSectionGetFieldDof, & - PetscSectionGetFieldOffset, & PetscViewerHDF5Open, & PetscViewerHDF5PushGroup, & PetscViewerHDF5PopGroup, & @@ -195,12 +174,7 @@ subroutine utilities_init() worldsize, & worldrank, & petsc_defaultOptions, & - petsc_options, & - structOrder, & - thermalOrder, & - damageOrder, & - soluteOrder, & - mgtwinOrder + petsc_options use debug, only: & debug_level, & debug_SPECTRAL, & @@ -215,22 +189,12 @@ subroutine utilities_init() mesh_maxNips, & geomMesh, & mesh_element - use homogenization, only: & - homogOutput, & - crystalliteOutput, & - phaseOutput use material, only: & - material_Nhomogenization, & - material_Ncrystallite, & - material_Nphase, & homogenization_Ngrains, & homogenization_maxNgrains, & material_homog, & material_phase, & - microstructure_crystallite, & - homogenization_name, & - crystallite_name, & - phase_name + microstructure_crystallite implicit none @@ -262,27 +226,15 @@ subroutine utilities_init() trim(PETScDebug), & ' add more using the PETSc_Options keyword in numerics.config ' flush(6) - call PetscOptionsClear(PETSC_NULL_OBJECT,ierr) + call PetscOptionsClear(PETSC_NULL_OPTIONS,ierr) CHKERRQ(ierr) - if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(PETSCDEBUG),ierr) + if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr) CHKERRQ(ierr) - call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_defaultOptions),ierr) - call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_options),ierr) + call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_defaultOptions),ierr) + call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr) CHKERRQ(ierr) - write(petsc_optionsPhysics,'(a,i0)') '-mechFE_petscspace_order ' , structOrder - call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_optionsPhysics),ierr) - CHKERRQ(ierr) - write(petsc_optionsPhysics,'(a,i0)') '-thermalFE_petscspace_order ', thermalOrder - call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_optionsPhysics),ierr) - CHKERRQ(ierr) - write(petsc_optionsPhysics,'(a,i0)') '-damageFE_petscspace_order ' , damageOrder - call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_optionsPhysics),ierr) - CHKERRQ(ierr) - write(petsc_optionsPhysics,'(a,i0)') '-soluteFE_petscspace_order ', soluteOrder - call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_optionsPhysics),ierr) - CHKERRQ(ierr) - write(petsc_optionsPhysics,'(a,i0)') '-mgtwinFE_petscspace_order ', mgtwinOrder - call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_optionsPhysics),ierr) + !write(petsc_optionsPhysics,'(a,i0)') '-mechFE_petscspace_order ' , structOrder + call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsPhysics),ierr) CHKERRQ(ierr) wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal) @@ -368,129 +320,126 @@ subroutine utilities_init() call PetscObjectSetName(coordinatesVec, 'NodalCoordinates',ierr) call VecSetFromOptions(coordinatesVec, ierr); CHKERRQ(ierr) - allocate(mappingCells(worldsize), source = 0) - allocate(homogenizationResultsVec(material_Nhomogenization )) - allocate(crystalliteResultsVec (material_Ncrystallite, homogenization_maxNgrains)) - allocate(phaseResultsVec (material_Nphase, homogenization_maxNgrains)) - do homog = 1, material_Nhomogenization - mappingCells = 0_pInt; mappingCells(worldrank+1) = homogOutput(homog)%sizeIpCells - call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) - call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & - homogenizationResultsVec(homog),ierr);CHKERRQ(ierr) - if (sum(mappingCells) > 0) then - call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & - connectivityVec,ierr);CHKERRQ(ierr) - call PetscObjectSetName(connectivityVec,'mapping_'//trim(homogenization_name(homog)),ierr) - CHKERRQ(ierr) - call VecGetArrayF90(connectivityVec,results,ierr); CHKERRQ(ierr) - results = 0.0_pReal; ctr = 1_pInt - do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips - if (material_homog(qPt,cell+1) == homog) then - results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & - shape=[2**dimPlex])) - ctr = ctr + 2**dimPlex - endif - enddo; enddo - call VecRestoreArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) - call VecAssemblyBegin(connectivityVec, ierr); CHKERRQ(ierr) - call VecAssemblyEnd (connectivityVec, ierr); CHKERRQ(ierr) - call VecView(connectivityVec, resUnit, ierr); CHKERRQ(ierr) - call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) - endif - enddo - do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains - mappingCells = 0_pInt - mappingCells(worldrank+1) = crystalliteOutput(cryst,grain)%sizeIpCells - call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) - call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & - crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr) - if (sum(mappingCells) > 0) then - call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & - connectivityVec,ierr);CHKERRQ(ierr) - write(grainStr,'(a,i0)') 'Grain',grain - call PetscObjectSetName(connectivityVec,'mapping_'// & - trim(crystallite_name(cryst))//'_'// & - trim(grainStr),ierr) - CHKERRQ(ierr) - call VecGetArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) - results = 0.0_pReal; ctr = 1_pInt - do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips - if (homogenization_Ngrains (mesh_element(3,cell+1)) >= grain .and. & - microstructure_crystallite(mesh_element(4,cell+1)) == cryst) then - results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & - shape=[2**dimPlex])) - ctr = ctr + 2**dimPlex - endif - enddo; enddo - call VecRestoreArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) - call VecAssemblyBegin(connectivityVec, ierr); CHKERRQ(ierr) - call VecAssemblyEnd (connectivityVec, ierr); CHKERRQ(ierr) - call VecView(connectivityVec, resUnit, ierr); CHKERRQ(ierr) - call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) - endif - enddo; enddo - do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains - mappingCells = 0_pInt - mappingCells(worldrank+1) = phaseOutput(phase,grain)%sizeIpCells - call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) - call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & - phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr) - if (sum(mappingCells) > 0) then - call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & - connectivityVec,ierr);CHKERRQ(ierr) - write(grainStr,'(a,i0)') 'Grain',grain - call PetscObjectSetName(connectivityVec,& - 'mapping_'//trim(phase_name(phase))//'_'// & - trim(grainStr),ierr) - CHKERRQ(ierr) - call VecGetArrayF90(connectivityVec, results, ierr) - CHKERRQ(ierr) - results = 0.0_pReal; ctr = 1_pInt - do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips - if (material_phase(grain,qPt,cell+1) == phase) then - results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & - shape=[2**dimPlex])) - ctr = ctr + 2**dimPlex - endif - enddo; enddo - call VecRestoreArrayF90(connectivityVec, results, ierr) - CHKERRQ(ierr) - call VecAssemblyBegin(connectivityVec, ierr);CHKERRQ(ierr) - call VecAssemblyEnd (connectivityVec, ierr);CHKERRQ(ierr) - call VecView(connectivityVec, resUnit, ierr);CHKERRQ(ierr) - call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) - endif - enddo; enddo - if (worldrank == 0_pInt) then - do homog = 1, material_Nhomogenization - call VecGetSize(homogenizationResultsVec(homog),mappingCells(1),ierr) - CHKERRQ(ierr) - if (mappingCells(1) > 0) & - write(headerID, '(a,i0)') 'number of homog_'// & - trim(homogenization_name(homog))//'_'// & - 'cells : ', mappingCells(1) - enddo - do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains - call VecGetSize(crystalliteResultsVec(cryst,grain),mappingCells(1),ierr) - CHKERRQ(ierr) - write(grainStr,'(a,i0)') 'Grain',grain - if (mappingCells(1) > 0) & - write(headerID, '(a,i0)') 'number of cryst_'// & - trim(crystallite_name(cryst))//'_'// & - trim(grainStr)//'_'// & - 'cells : ', mappingCells(1) - enddo; enddo - do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains - call VecGetSize(phaseResultsVec(phase,grain),mappingCells(1),ierr) - CHKERRQ(ierr) - write(grainStr,'(a,i0)') 'Grain',grain - if (mappingCells(1) > 0) & - write(headerID, '(a,i0)') 'number of phase_'// & - trim(phase_name(phase))//'_'//trim(grainStr)//'_'// & - 'cells : ', mappingCells(1) - enddo; enddo - close(headerID) - endif + !allocate(mappingCells(worldsize), source = 0) + !do homog = 1, material_Nhomogenization + ! mappingCells = 0_pInt; mappingCells(worldrank+1) = homogOutput(homog)%sizeIpCells + ! call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & + ! homogenizationResultsVec(homog),ierr);CHKERRQ(ierr) + ! if (sum(mappingCells) > 0) then + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & + ! connectivityVec,ierr);CHKERRQ(ierr) + ! call PetscObjectSetName(connectivityVec,'mapping_'//trim(homogenization_name(homog)),ierr) + ! CHKERRQ(ierr) + ! call VecGetArrayF90(connectivityVec,results,ierr); CHKERRQ(ierr) + ! results = 0.0_pReal; ctr = 1_pInt + ! do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips + ! if (material_homog(qPt,cell+1) == homog) then + ! results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & + ! shape=[2**dimPlex])) + ! ctr = ctr + 2**dimPlex + ! endif + ! enddo; enddo + ! call VecRestoreArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) + ! call VecAssemblyBegin(connectivityVec, ierr); CHKERRQ(ierr) + ! call VecAssemblyEnd (connectivityVec, ierr); CHKERRQ(ierr) + ! call VecView(connectivityVec, resUnit, ierr); CHKERRQ(ierr) + ! call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) + ! endif + !enddo + !do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains + ! mappingCells = 0_pInt + ! mappingCells(worldrank+1) = crystalliteOutput(cryst,grain)%sizeIpCells + ! call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & + ! crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr) + ! if (sum(mappingCells) > 0) then + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & + ! connectivityVec,ierr);CHKERRQ(ierr) + ! write(grainStr,'(a,i0)') 'Grain',grain + ! call PetscObjectSetName(connectivityVec,'mapping_'// & + ! trim(crystallite_name(cryst))//'_'// & + ! trim(grainStr),ierr) + ! CHKERRQ(ierr) + ! call VecGetArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) + ! results = 0.0_pReal; ctr = 1_pInt + ! do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips + ! if (homogenization_Ngrains (mesh_element(3,cell+1)) >= grain .and. & + ! microstructure_crystallite(mesh_element(4,cell+1)) == cryst) then + ! results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & + ! shape=[2**dimPlex])) + ! ctr = ctr + 2**dimPlex + ! endif + ! enddo; enddo + ! call VecRestoreArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) + ! call VecAssemblyBegin(connectivityVec, ierr); CHKERRQ(ierr) + ! call VecAssemblyEnd (connectivityVec, ierr); CHKERRQ(ierr) + ! call VecView(connectivityVec, resUnit, ierr); CHKERRQ(ierr) + ! call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) + ! endif + !enddo; enddo + !do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains + ! mappingCells = 0_pInt + ! mappingCells(worldrank+1) = phaseOutput(phase,grain)%sizeIpCells + ! call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & + ! phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr) + ! if (sum(mappingCells) > 0) then + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & + ! connectivityVec,ierr);CHKERRQ(ierr) + ! write(grainStr,'(a,i0)') 'Grain',grain + ! call PetscObjectSetName(connectivityVec,& + ! 'mapping_'//trim(phase_name(phase))//'_'// & + ! trim(grainStr),ierr) + ! CHKERRQ(ierr) + ! call VecGetArrayF90(connectivityVec, results, ierr) + ! CHKERRQ(ierr) + ! results = 0.0_pReal; ctr = 1_pInt + ! do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips + ! if (material_phase(grain,qPt,cell+1) == phase) then + ! results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & + ! shape=[2**dimPlex])) + ! ctr = ctr + 2**dimPlex + ! endif + ! enddo; enddo + ! call VecRestoreArrayF90(connectivityVec, results, ierr) + ! CHKERRQ(ierr) + ! call VecAssemblyBegin(connectivityVec, ierr);CHKERRQ(ierr) + ! call VecAssemblyEnd (connectivityVec, ierr);CHKERRQ(ierr) + ! call VecView(connectivityVec, resUnit, ierr);CHKERRQ(ierr) + ! call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) + ! endif + !enddo; enddo + !if (worldrank == 0_pInt) then + ! do homog = 1, material_Nhomogenization + ! call VecGetSize(homogenizationResultsVec(homog),mappingCells(1),ierr) + ! CHKERRQ(ierr) + ! if (mappingCells(1) > 0) & + ! write(headerID, '(a,i0)') 'number of homog_'// & + ! trim(homogenization_name(homog))//'_'// & + ! 'cells : ', mappingCells(1) + ! enddo + ! do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains + ! call VecGetSize(crystalliteResultsVec(cryst,grain),mappingCells(1),ierr) + ! CHKERRQ(ierr) + ! write(grainStr,'(a,i0)') 'Grain',grain + ! if (mappingCells(1) > 0) & + ! write(headerID, '(a,i0)') 'number of cryst_'// & + ! trim(crystallite_name(cryst))//'_'// & + ! trim(grainStr)//'_'// & + ! 'cells : ', mappingCells(1) + ! enddo; enddo + ! do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains + ! call VecGetSize(phaseResultsVec(phase,grain),mappingCells(1),ierr) + ! CHKERRQ(ierr) + ! write(grainStr,'(a,i0)') 'Grain',grain + ! if (mappingCells(1) > 0) & + ! write(headerID, '(a,i0)') 'number of phase_'// & + ! trim(phase_name(phase))//'_'//trim(grainStr)//'_'// & + ! 'cells : ', mappingCells(1) + ! enddo; enddo + ! close(headerID) + !endif end subroutine utilities_init @@ -509,13 +458,12 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) math_det33 use FEsolving, only: & restartWrite - use CPFEM2, only: & - CPFEM_general use homogenization, only: & materialpoint_F0, & materialpoint_F, & materialpoint_P, & - materialpoint_dPdF + materialpoint_dPdF, & + materialpoint_stressAndItsTangent use mesh, only: & mesh_NcpElems @@ -560,8 +508,8 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) flush(6) endif - call CPFEM_general(age,timeinc) - + call materialpoint_stressAndItsTangent(.true.,timeinc) ! calculate P field + call debug_info() restartWrite = .false. ! reset restartWrite status @@ -791,27 +739,24 @@ end subroutine utilities_indexActiveSet !-------------------------------------------------------------------------------------------------- subroutine utilities_destroy() use material, only: & - material_Nhomogenization, & - material_Ncrystallite, & - material_Nphase, & homogenization_Ngrains - implicit none - PetscInt :: homog, cryst, grain, phase - PetscErrorCode :: ierr + !implicit none + !PetscInt :: homog, cryst, grain, phase + !PetscErrorCode :: ierr - call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr) - call VecDestroy(coordinatesVec,ierr); CHKERRQ(ierr) - do homog = 1, material_Nhomogenization - call VecDestroy(homogenizationResultsVec(homog),ierr);CHKERRQ(ierr) - do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_Ngrains(homog) - call VecDestroy(crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr) - enddo; enddo - do phase = 1, material_Nphase; do grain = 1, homogenization_Ngrains(homog) - call VecDestroy(phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr) - enddo; enddo - enddo - call PetscViewerDestroy(resUnit, ierr); CHKERRQ(ierr) + !call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr) + !call VecDestroy(coordinatesVec,ierr); CHKERRQ(ierr) + !do homog = 1, material_Nhomogenization + ! call VecDestroy(homogenizationResultsVec(homog),ierr);CHKERRQ(ierr) + ! do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_Ngrains(homog) + ! call VecDestroy(crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr) + ! enddo; enddo + ! do phase = 1, material_Nphase; do grain = 1, homogenization_Ngrains(homog) + ! call VecDestroy(phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr) + ! enddo; enddo + !enddo + !call PetscViewerDestroy(resUnit, ierr); CHKERRQ(ierr) end subroutine utilities_destroy diff --git a/src/FEM_zoo.f90 b/src/FEM_zoo.f90 index 2c4250098..c34dfb449 100644 --- a/src/FEM_zoo.f90 +++ b/src/FEM_zoo.f90 @@ -6,7 +6,6 @@ module FEM_Zoo use prec, only: pReal, pInt, p_vec implicit none -#include private integer(pInt), parameter, public:: & maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary) @@ -35,26 +34,23 @@ contains !> @brief initializes FEM interpolation data !-------------------------------------------------------------------------------------------------- subroutine FEM_Zoo_init - use, intrinsic :: iso_fortran_env +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use IO, only: & IO_timeStamp use math, only: & math_binomial implicit none - PetscInt :: worldrank - PetscErrorCode :: ierr - external :: & - MPI_Comm_rank, & - MPI_abort - call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) - if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- FEM_Zoo init -+>>>' - write(6,'(a)') ' $Id: FEM_Zoo.f90 4354 2015-08-04 15:04:53Z MPIE\p.shanthraj $' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- FEM_Zoo init -+>>>' + write(6,'(a)') ' $Id: FEM_Zoo.f90 4354 2015-08-04 15:04:53Z MPIE\p.shanthraj $' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif + !-------------------------------------------------------------------------------------------------- ! 2D linear FEM_Zoo_nQuadrature(2,1) = 1 diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 3565999a8..951527b19 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -6,9 +6,6 @@ !-------------------------------------------------------------------------------------------------- module homogenization use prec, only: & -#ifdef FEM - tOutputData, & -#endif pInt, & pReal @@ -22,16 +19,8 @@ module homogenization materialpoint_P !< first P--K stress of IP real(pReal), dimension(:,:,:,:,:,:), allocatable, public :: & materialpoint_dPdF !< tangent of first P--K stress at IP -#ifdef FEM - type(tOutputData), dimension(:), allocatable, public :: & - homogOutput - type(tOutputData), dimension(:,:), allocatable, public :: & - crystalliteOutput, & - phaseOutput -#else real(pReal), dimension(:,:,:), allocatable, public :: & materialpoint_results !< results array of material point -#endif integer(pInt), public, protected :: & materialpoint_sizeResults, & homogenization_maxSizePostResults, & @@ -90,16 +79,11 @@ subroutine homogenization_init mesh_element, & FE_Nips, & FE_geomtype -#ifdef FEM - use crystallite, only: & - crystallite_sizePostResults -#else use constitutive, only: & constitutive_plasticity_maxSizePostResults, & constitutive_source_maxSizePostResults use crystallite, only: & crystallite_maxSizePostResults -#endif use config, only: & config_deallocate, & material_configFile, & @@ -411,33 +395,6 @@ subroutine homogenization_init hydrogenflux_maxSizePostResults = max(hydrogenflux_maxSizePostResults ,hydrogenfluxState(p)%sizePostResults) enddo -#ifdef FEM - allocate(homogOutput (material_Nhomogenization )) - allocate(crystalliteOutput(material_Ncrystallite, homogenization_maxNgrains)) - allocate(phaseOutput (material_Nphase, homogenization_maxNgrains)) - do p = 1, material_Nhomogenization - homogOutput(p)%sizeResults = homogState (p)%sizePostResults + & - thermalState (p)%sizePostResults + & - damageState (p)%sizePostResults + & - vacancyfluxState (p)%sizePostResults + & - porosityState (p)%sizePostResults + & - hydrogenfluxState(p)%sizePostResults - homogOutput(p)%sizeIpCells = count(material_homog==p) - allocate(homogOutput(p)%output(homogOutput(p)%sizeResults,homogOutput(p)%sizeIpCells)) - enddo - do p = 1, material_Ncrystallite; do e = 1, homogenization_maxNgrains - crystalliteOutput(p,e)%sizeResults = crystallite_sizePostResults(p) - crystalliteOutput(p,e)%sizeIpCells = count(microstructure_crystallite(mesh_element(4,:)) == p .and. & - homogenization_Ngrains (mesh_element(3,:)) >= e)*mesh_maxNips - allocate(crystalliteOutput(p,e)%output(crystalliteOutput(p,e)%sizeResults,crystalliteOutput(p,e)%sizeIpCells)) - enddo; enddo - do p = 1, material_Nphase; do e = 1, homogenization_maxNgrains - phaseOutput(p,e)%sizeResults = plasticState (p)%sizePostResults + & - sum(sourceState (p)%p(:)%sizePostResults) - phaseOutput(p,e)%sizeIpCells = count(material_phase(e,:,:) == p) - allocate(phaseOutput(p,e)%output(phaseOutput(p,e)%sizeResults,phaseOutput(p,e)%sizeIpCells)) - enddo; enddo -#else materialpoint_sizeResults = 1 & ! grain count + 1 + homogenization_maxSizePostResults & ! homogSize & homogResult + thermal_maxSizePostResults & @@ -449,7 +406,6 @@ subroutine homogenization_init + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results + constitutive_source_maxSizePostResults) allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems)) -#endif write(6,'(/,a)') ' <<<+- homogenization init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -473,9 +429,6 @@ subroutine homogenization_init write(6,'(a32,1x,7(i8,1x))') 'materialpoint_requested: ', shape(materialpoint_requested) write(6,'(a32,1x,7(i8,1x))') 'materialpoint_converged: ', shape(materialpoint_converged) write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_doneAndHappy: ', shape(materialpoint_doneAndHappy) -#ifndef FEM - write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_results: ', shape(materialpoint_results) -#endif write(6,'(a32,1x,7(i8,1x))') 'maxSizePostResults: ', homogenization_maxSizePostResults endif flush(6) @@ -904,33 +857,18 @@ subroutine materialpoint_postResults mesh_element use material, only: & mappingHomogenization, & -#ifdef FEM - phaseAt, phasememberAt, & - homogenization_maxNgrains, & - material_Ncrystallite, & - material_Nphase, & -#else homogState, & thermalState, & damageState, & vacancyfluxState, & porosityState, & hydrogenfluxState, & -#endif plasticState, & sourceState, & material_phase, & homogenization_Ngrains, & microstructure_crystallite -#ifdef FEM - use constitutive, only: & - constitutive_plasticity_maxSizePostResults, & - constitutive_source_maxSizePostResults -#endif use crystallite, only: & -#ifdef FEM - crystallite_maxSizePostResults, & -#endif crystallite_sizePostResults, & crystallite_postResults @@ -943,55 +881,6 @@ subroutine materialpoint_postResults g, & !< grain number i, & !< integration point number e !< element number -#ifdef FEM - integer(pInt) :: & - myHomog, & - myPhase, & - crystalliteCtr(material_Ncrystallite, homogenization_maxNgrains), & - phaseCtr (material_Nphase, homogenization_maxNgrains) - real(pReal), dimension(1+crystallite_maxSizePostResults + & - 1+constitutive_plasticity_maxSizePostResults + & - constitutive_source_maxSizePostResults) :: & - crystalliteResults - - - - crystalliteCtr = 0_pInt; phaseCtr = 0_pInt - elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNgrains = homogenization_Ngrains(mesh_element(3,e)) - myCrystallite = microstructure_crystallite(mesh_element(4,e)) - IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - myHomog = mappingHomogenization(2,i,e) - thePos = mappingHomogenization(1,i,e) - homogOutput(myHomog)%output(1: & - homogOutput(myHomog)%sizeResults, & - thePos) = homogenization_postResults(i,e) - - grainLooping :do g = 1,myNgrains - myPhase = phaseAt(g,i,e) - crystalliteResults(1:1+crystallite_sizePostResults(myCrystallite) + & - 1+plasticState(myPhase)%sizePostResults + & - sum(sourceState(myPhase)%p(:)%sizePostResults)) = crystallite_postResults(g,i,e) - if (microstructure_crystallite(mesh_element(4,e)) == myCrystallite .and. & - homogenization_Ngrains (mesh_element(3,e)) >= g) then - crystalliteCtr(myCrystallite,g) = crystalliteCtr(myCrystallite,g) + 1_pInt - crystalliteOutput(myCrystallite,g)% & - output(1:crystalliteOutput(myCrystallite,g)%sizeResults,crystalliteCtr(myCrystallite,g)) = & - crystalliteResults(2:1+crystalliteOutput(myCrystallite,g)%sizeResults) - endif - if (material_phase(g,i,e) == myPhase) then - phaseCtr(myPhase,g) = phaseCtr(myPhase,g) + 1_pInt - phaseOutput(myPhase,g)% & - output(1:phaseOutput(myPhase,g)%sizeResults,phaseCtr(myPhase,g)) = & - crystalliteResults(3 + crystalliteOutput(myCrystallite,g)%sizeResults: & - 1 + crystalliteOutput(myCrystallite,g)%sizeResults + & - 1 + plasticState (myphase)%sizePostResults + & - sum(sourceState(myphase)%p(:)%sizePostResults)) - endif - enddo grainLooping - enddo IpLooping - enddo elementLooping -#else !$OMP PARALLEL DO PRIVATE(myNgrains,myCrystallite,thePos,theSize) elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2) @@ -1027,7 +916,6 @@ subroutine materialpoint_postResults enddo IpLooping enddo elementLooping !$OMP END PARALLEL DO -#endif end subroutine materialpoint_postResults diff --git a/src/meshFEM.f90 b/src/meshFEM.f90 new file mode 100644 index 000000000..7dc5c93af --- /dev/null +++ b/src/meshFEM.f90 @@ -0,0 +1,444 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Driver controlling inner and outer load case looping of the FEM solver +!> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing +!> results +!-------------------------------------------------------------------------------------------------- +module mesh +#include +#include + use prec, only: pReal, pInt + +use PETScdmda +use PETScis + + implicit none + private + + integer(pInt), public, protected :: & + mesh_Nboundaries, & + mesh_NcpElems, & !< total number of CP elements in mesh + mesh_NcpElemsGlobal, & + mesh_Nnodes, & !< total number of nodes in mesh + mesh_maxNnodes, & !< max number of nodes in any CP element + mesh_maxNips, & !< max number of IPs in any CP element + mesh_maxNipNeighbors, & + mesh_Nelems !< total number of elements in mesh + + real(pReal), public, protected :: charLength + + integer(pInt), dimension(:,:), allocatable, public, protected :: & + mesh_element !< FEid, type(internal representation), material, texture, node indices as CP IDs + + real(pReal), dimension(:,:), allocatable, public :: & + mesh_node !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + + real(pReal), dimension(:,:), allocatable, public, protected :: & + mesh_ipVolume, & !< volume associated with IP (initially!) + mesh_node0 !< node x,y,z coordinates (initially!) + + real(pReal), dimension(:,:,:), allocatable, public :: & + mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) + + real(pReal), dimension(:,:,:), allocatable, public, protected :: & + mesh_ipArea !< area of interface to neighboring IP (initially!) + + real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) + + integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] + + logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) + + integer(pInt), dimension(:,:), allocatable, target, private :: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] + + DM, public :: geomMesh + + integer(pInt), dimension(:), allocatable, public, protected :: & + mesh_boundaries + +! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) +! Hence, I suggest to prefix with "FE_" + + integer(pInt), parameter, public :: & + FE_Nelemtypes = 1_pInt, & + FE_Ngeomtypes = 1_pInt, & + FE_Ncelltypes = 1_pInt, & + FE_maxNnodes = 1_pInt, & + FE_maxNips = 14_pInt + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type + int([1],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type + int([1],pInt) + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element + int([0],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), public :: FE_Nips = & !< number of IPs in a specific type of element + int([0],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + int([6],pInt) + + + public :: & + mesh_init, & + mesh_FEasCP, & + mesh_FEM_build_ipVolumes, & + mesh_FEM_build_ipCoordinates, & + mesh_cellCenterCoordinates + + external :: & + MPI_Bcast, & + DMPlexCreateFromFile, & + DMPlexDistribute, & + DMPlexCopyCoordinates, & + DMGetStratumSize, & + DMPlexGetHeightStratum, & + DMPlexGetLabelValue, & + DMPlexSetLabelValue + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes the mesh by calling all necessary private routines the mesh module +!! Order and routines strongly depend on type of solver +!-------------------------------------------------------------------------------------------------- +subroutine mesh_init(ip,el) + use DAMASK_interface + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use IO, only: & + IO_timeStamp, & + IO_error, & + IO_open_file, & + IO_stringPos, & + IO_intValue, & + IO_EOF, & + IO_read, & + IO_isBlank + use debug, only: & + debug_e, & + debug_i + use numerics, only: & + usePingPong, & + integrationOrder, & + worldrank, & + worldsize + use FEsolving, only: & + FEsolving_execElem, & + FEsolving_execIP, & + calcMode + use FEM_Zoo, only: & + FEM_Zoo_nQuadrature, & + FEM_Zoo_QuadraturePoints + + implicit none + integer(pInt), parameter :: FILEUNIT = 222_pInt + integer(pInt), intent(in) :: el, ip + integer(pInt) :: j + integer(pInt), allocatable, dimension(:) :: chunkPos + integer :: dimPlex + character(len=512) :: & + line + logical :: flag + PetscSF :: sf + DM :: globalMesh + PetscInt :: face, nFaceSets + PetscInt, pointer :: pFaceSets(:) + IS :: faceSetIS + PetscErrorCode :: ierr + + + write(6,'(/,a)') ' <<<+- mesh init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + + if (allocated(mesh_mapFEtoCPelem)) deallocate(mesh_mapFEtoCPelem) + if (allocated(mesh_mapFEtoCPnode)) deallocate(mesh_mapFEtoCPnode) + if (allocated(mesh_node0)) deallocate(mesh_node0) + if (allocated(mesh_node)) deallocate(mesh_node) + if (allocated(mesh_element)) deallocate(mesh_element) + if (allocated(mesh_ipCoordinates)) deallocate(mesh_ipCoordinates) + if (allocated(mesh_ipVolume)) deallocate(mesh_ipVolume) + + call DMPlexCreateFromFile(PETSC_COMM_WORLD,geometryFile,PETSC_TRUE,globalMesh,ierr) + CHKERRQ(ierr) + call DMGetDimension(globalMesh,dimPlex,ierr) + CHKERRQ(ierr) + call DMGetStratumSize(globalMesh,'depth',dimPlex,mesh_NcpElemsGlobal,ierr) + CHKERRQ(ierr) + call DMGetLabelSize(globalMesh,'Face Sets',mesh_Nboundaries,ierr) + CHKERRQ(ierr) + call MPI_Bcast(mesh_Nboundaries,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + call MPI_Bcast(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + call MPI_Bcast(dimPlex,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + + allocate(mesh_boundaries(mesh_Nboundaries), source = 0_pInt) + call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr) + CHKERRQ(ierr) + call DMGetLabelIdIS(globalMesh,'Face Sets',faceSetIS,ierr) + CHKERRQ(ierr) + if (nFaceSets > 0) call ISGetIndicesF90(faceSetIS,pFaceSets,ierr) + do face = 1, nFaceSets + mesh_boundaries(face) = pFaceSets(face) + enddo + if (nFaceSets > 0) call ISRestoreIndicesF90(faceSetIS,pFaceSets,ierr) + call MPI_Bcast(mesh_boundaries,mesh_Nboundaries,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + + if (worldrank == 0) then + j = 0 + flag = .false. + call IO_open_file(FILEUNIT,trim(geometryFile)) + do + read(FILEUNIT,'(a512)') line + if (trim(line) == IO_EOF) exit ! skip empty lines + if (trim(line) == '$Elements') then + read(FILEUNIT,'(a512)') line + read(FILEUNIT,'(a512)') line + flag = .true. + endif + if (trim(line) == '$EndElements') exit + if (flag) then + chunkPos = IO_stringPos(line) + if (chunkPos(1) == 3+IO_intValue(line,chunkPos,3)+dimPlex+1) then + call DMSetLabelValue(globalMesh,'material',j,IO_intValue(line,chunkPos,4),ierr) + CHKERRQ(ierr) + j = j + 1 + endif ! count all identifiers to allocate memory and do sanity check + endif + enddo + close (FILEUNIT) + endif + + if (worldsize > 1) then + call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr) + CHKERRQ(ierr) + else + call DMClone(globalMesh,geomMesh,ierr) + CHKERRQ(ierr) + endif + call DMDestroy(globalMesh,ierr); CHKERRQ(ierr) + + call DMGetStratumSize(geomMesh,'depth',dimPlex,mesh_Nelems,ierr) + CHKERRQ(ierr) + call DMGetStratumSize(geomMesh,'depth',0,mesh_Nnodes,ierr) + CHKERRQ(ierr) + mesh_NcpElems = mesh_Nelems + call mesh_FEM_mapNodesAndElems + + FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder) + mesh_maxNnodes = FE_Nnodes(1_pInt) + mesh_maxNips = FE_Nips(1_pInt) + call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p) + call mesh_FEM_build_ipVolumes(dimPlex) + + allocate (mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems)); mesh_element = 0_pInt + do j = 1, mesh_NcpElems + mesh_element( 1,j) = j + mesh_element( 2,j) = 1_pInt ! elem type + mesh_element( 3,j) = 1_pInt ! homogenization + call DMGetLabelValue(geomMesh,'material',j-1,mesh_element(4,j),ierr) + CHKERRQ(ierr) + end do + + if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & + call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements + if (debug_e < 1 .or. debug_e > mesh_NcpElems) & + call IO_error(602_pInt,ext_msg='element') ! selected element does not exist + if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & + call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP + + FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements + if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP) + allocate(FEsolving_execIP(2_pInt,mesh_NcpElems)); FEsolving_execIP = 1_pInt ! parallel loop bounds set to comprise from first IP... + forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element + + if (allocated(calcMode)) deallocate(calcMode) + allocate(calcMode(mesh_maxNips,mesh_NcpElems)) + calcMode = .false. ! pretend to have collected what first call is asking (F = I) + calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" + +end subroutine mesh_init + +!-------------------------------------------------------------------------------------------------- +!> @brief Gives the FE to CP ID mapping by binary search through lookup array +!! valid questions (what) are 'elem', 'node' +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_FEasCP(what,myID) + use IO, only: & + IO_lc + + implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID + + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center + + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),pInt) + + if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2_pInt,lower) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch + +end function mesh_FEasCP + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), intent(in) :: el, & !< element number + ip !< integration point number + real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell + + end function mesh_cellCenterCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_FEM_build_ipVolumes(dimPlex) + use math, only: & + math_I3, & + math_det33 + + implicit none + PetscInt :: dimPlex + PetscReal :: vol + PetscReal, target :: cent(dimPlex), norm(dimPlex) + PetscReal, pointer :: pCent(:), pNorm(:) + PetscInt :: cellStart, cellEnd, cell + PetscErrorCode :: ierr + + if (.not. allocated(mesh_ipVolume)) then + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) + mesh_ipVolume = 0.0_pReal + endif + + call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + pCent => cent + pNorm => norm + do cell = cellStart, cellEnd-1 + call DMPlexComputeCellGeometryFVM(geomMesh,cell,vol,pCent,pNorm,ierr) + CHKERRQ(ierr) + mesh_ipVolume(:,cell+1) = vol/real(mesh_maxNips,pReal) + enddo + +end subroutine mesh_FEM_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints) + + implicit none + PetscInt, intent(in) :: dimPlex + PetscReal, intent(in) :: qPoints(mesh_maxNips*dimPlex) + PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), invcellJ(dimPlex*dimPlex) + PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) + PetscReal :: detJ + PetscInt :: cellStart, cellEnd, cell, qPt, dirI, dirJ, qOffset + PetscErrorCode :: ierr + + if (.not. allocated(mesh_ipCoordinates)) then + allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems)) + mesh_ipCoordinates = 0.0_pReal + endif + + pV0 => v0 + pCellJ => cellJ + pInvcellJ => invcellJ + call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexComputeCellGeometryAffineFEM(geomMesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + qOffset = 0 + do qPt = 1, mesh_maxNips + do dirI = 1, dimPlex + 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) + enddo + enddo + qOffset = qOffset + dimPlex + enddo + enddo + +end subroutine mesh_FEM_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief fake map node from FE ID to internal (consecutive) representation for node and element +!! Allocates global array 'mesh_mapFEtoCPnode' and 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_FEM_mapNodesAndElems + use math, only: & + math_range + + implicit none + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source = 0_pInt) + allocate (mesh_mapFEtoCPelem(2_pInt,mesh_NcpElems), source = 0_pInt) + + mesh_mapFEtoCPnode = spread(math_range(mesh_Nnodes),1,2) + mesh_mapFEtoCPelem = spread(math_range(mesh_NcpElems),1,2) + +end subroutine mesh_FEM_mapNodesAndElems + + +end module mesh From 08d6cb242f29c01e0f488648b97eb003a2dc7eab Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 17 Aug 2018 15:42:35 -0400 Subject: [PATCH 117/208] adopted new name for covera_ratio: c/a --- examples/SpectralMethod/EshelbyInclusion/material.config | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/SpectralMethod/EshelbyInclusion/material.config b/examples/SpectralMethod/EshelbyInclusion/material.config index 83045938d..e002584b0 100644 --- a/examples/SpectralMethod/EshelbyInclusion/material.config +++ b/examples/SpectralMethod/EshelbyInclusion/material.config @@ -38,7 +38,7 @@ plasticity none [Ti matrix] lattice_structure hex -covera_ratio 1.587 +c/a 1.587 plasticity none {config/elastic_Ti.config} {config/thermal.config} @@ -65,7 +65,7 @@ plasticity none [Ti inclusion] lattice_structure hex -covera_ratio 1.587 +c/a 1.587 plasticity none {config/elastic_Ti.config} {config/thermal.config} From c03ea8f5c7e93c2cbd7849d0eb0e48332c207e4e Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 17 Aug 2018 15:43:09 -0400 Subject: [PATCH 118/208] added forgotten C66(2,2) read-in from parameter database --- src/lattice.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/lattice.f90 b/src/lattice.f90 index 2b7fe5774..ca1cd597a 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1396,6 +1396,7 @@ subroutine lattice_init lattice_C66(1,1,p) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) lattice_C66(1,2,p) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) lattice_C66(1,3,p) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) + lattice_C66(2,2,p) = config_phase(p)%getFloat('c22',defaultVal=0.0_pReal) lattice_C66(2,3,p) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) lattice_C66(3,3,p) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) lattice_C66(4,4,p) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) From 0d8f17cbe61b4f3367a88da335d44864f67692fc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 Aug 2018 14:05:57 +0200 Subject: [PATCH 119/208] adjusting to PETSc 3.9.x --- src/FEM_mech.f90 | 288 +++--------------------------------------- src/FEM_utilities.f90 | 25 +--- 2 files changed, 23 insertions(+), 290 deletions(-) diff --git a/src/FEM_mech.f90 b/src/FEM_mech.f90 index 6cf47980e..bc829b436 100644 --- a/src/FEM_mech.f90 +++ b/src/FEM_mech.f90 @@ -5,6 +5,10 @@ !> @brief FEM PETSc solver !-------------------------------------------------------------------------------------------------- module FEM_mech +#include + +use PETScdmda +use PETScsnes use prec, only: & pInt, & pReal @@ -23,7 +27,6 @@ module FEM_mech implicit none private -#include !-------------------------------------------------------------------------------------------------- ! derived types @@ -40,7 +43,7 @@ module FEM_mech SNES, private :: mech_snes Vec, private :: solution, solution_rate, solution_local PetscInt, private :: dimPlex, cellDof, nQuadrature, nBasis - PetscReal, allocatable, target, private :: qPoints(:), qWeights(:) + PetscReal, allocatable, target,dimension(:), private :: qPoints, qWeights MatNullSpace, private :: matnull !-------------------------------------------------------------------------------------------------- @@ -55,32 +58,11 @@ module FEM_mech FEM_mech_init, & FEM_mech_solution ,& FEM_mech_forward, & - FEM_mech_output, & FEM_mech_destroy external :: & - MPI_abort, & MPI_Allreduce, & - VecCopy, & - VecSet, & - VecISSet, & - VecScale, & - VecWAXPY, & - VecAXPY, & - VecGetSize, & - VecAssemblyBegin, & - VecAssemblyEnd, & - VecView, & - VecDestroy, & - MatSetOption, & - MatSetLocalToGlobalMapping, & - MatSetNearNullSpace, & - MatZeroEntries, & MatZeroRowsColumnsLocalIS, & - MatAssemblyBegin, & - MatAssemblyEnd, & - MatScale, & - MatNullSpaceCreateRigidBody, & PetscQuadratureCreate, & PetscFECreateDefault, & PetscFESetQuadrature, & @@ -92,39 +74,14 @@ module FEM_mech PetscDSGetTotalDimension, & PetscDSGetDiscretization, & PetscDualSpaceGetFunctional, & - DMClone, & - DMCreateGlobalVector, & - DMGetDS, & - DMGetDimension, & - DMGetDefaultSection, & - DMGetDefaultGlobalSection, & - DMGetLocalToGlobalMapping, & - DMGetLocalVector, & DMGetLabelSize, & DMPlexCopyCoordinates, & DMPlexGetHeightStratum, & DMPlexGetDepthStratum, & - DMLocalToGlobalBegin, & - DMLocalToGlobalEnd, & - DMGlobalToLocalBegin, & - DMGlobalToLocalEnd, & - DMRestoreLocalVector, & DMSNESSetFunctionLocal, & DMSNESSetJacobianLocal, & - SNESCreate, & SNESSetOptionsPrefix, & - SNESSetDM, & - SNESSetMaxLinearSolveFailures, & SNESSetConvergenceTest, & - SNESSetTolerances, & - SNESSetFromOptions, & - SNESGetDM, & - SNESGetConvergedReason, & - SNESGetIterationNumber, & - SNESSolve, & - SNESDestroy, & - PetscViewerHDF5PushGroup, & - PetscViewerHDF5PopGroup, & PetscObjectSetName contains @@ -177,12 +134,10 @@ subroutine FEM_mech_init(fieldBC) PetscInt :: cellStart, cellEnd, cell, basis character(len=7) :: prefix = 'mechFE_' PetscErrorCode :: ierr - - if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- FEM_mech init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + + write(6,'(/,a)') ' <<<+- FEM_mech init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif !-------------------------------------------------------------------------------------------------- ! Setup FEM mech mesh @@ -248,13 +203,13 @@ subroutine FEM_mech_init(fieldBC) call ISRestoreIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr) call ISDestroy(bcPoint,ierr); CHKERRQ(ierr) else - call ISCreateGeneral(PETSC_COMM_WORLD,0,0,PETSC_COPY_VALUES,bcPoints(numBC),ierr) + call ISCreateGeneral(PETSC_COMM_WORLD,0,[0],PETSC_COPY_VALUES,bcPoints(numBC),ierr) CHKERRQ(ierr) endif endif enddo; enddo call DMPlexCreateSection(mech_mesh,dimPlex,1,pNumComp,pNumDof, & - numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_OBJECT, & + numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_VEC, & section,ierr) CHKERRQ(ierr) call DMSetDefaultSection(mech_mesh,section,ierr); CHKERRQ(ierr) @@ -270,12 +225,12 @@ subroutine FEM_mech_init(fieldBC) call DMCreateGlobalVector(mech_mesh,solution ,ierr); CHKERRQ(ierr) !< locally owned displacement Dofs call DMCreateGlobalVector(mech_mesh,solution_rate ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step call DMCreateLocalVector (mech_mesh,solution_local ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step - call DMSNESSetFunctionLocal(mech_mesh,FEM_mech_formResidual,PETSC_NULL_OBJECT,ierr) !< function to evaluate residual forces + call DMSNESSetFunctionLocal(mech_mesh,FEM_mech_formResidual,PETSC_NULL_VEC,ierr) !< function to evaluate residual forces CHKERRQ(ierr) - call DMSNESSetJacobianLocal(mech_mesh,FEM_mech_formJacobian,PETSC_NULL_OBJECT,ierr) !< function to evaluate stiffness matrix + call DMSNESSetJacobianLocal(mech_mesh,FEM_mech_formJacobian,PETSC_NULL_VEC,ierr) !< function to evaluate stiffness matrix CHKERRQ(ierr) call SNESSetMaxLinearSolveFailures(mech_snes, huge(1), ierr); CHKERRQ(ierr) !< ignore linear solve failures - call SNESSetConvergenceTest(mech_snes,FEM_mech_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) + call SNESSetConvergenceTest(mech_snes,FEM_mech_converged,PETSC_NULL_VEC,PETSC_NULL_FUNCTION,ierr) CHKERRQ(ierr) call SNESSetTolerances(mech_snes,1.0,0.0,0.0,itmax,itmax,ierr) CHKERRQ(ierr) @@ -357,7 +312,7 @@ type(tSolutionState) function FEM_mech_solution( & params%timeincOld = timeinc_old params%fieldBC = fieldBC - call SNESSolve(mech_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr) ! solve mech_snes based on solution guess (result in solution) + call SNESSolve(mech_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) ! solve mech_snes based on solution guess (result in solution) call SNESGetConvergedReason(mech_snes,reason,ierr); CHKERRQ(ierr) ! solution converged? terminallyIll = .false. @@ -370,10 +325,8 @@ type(tSolutionState) function FEM_mech_solution( & CHKERRQ(ierr) endif - if (worldrank == 0) then - write(6,'(/,a)') ' ===========================================================================' - flush(6) - endif + write(6,'(/,a)') ' ===========================================================================' + flush(6) end function FEM_mech_solution @@ -765,215 +718,6 @@ subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dumm end subroutine FEM_mech_converged -!-------------------------------------------------------------------------------------------------- -!> @brief output routine -!-------------------------------------------------------------------------------------------------- -subroutine FEM_mech_output(inc,fieldBC) - use material, only: & - material_Nhomogenization, & - material_Ncrystallite, & - material_Nphase, & - homogenization_maxNgrains, & - homogenization_name, & - crystallite_name, & - phase_name - use homogenization, only: & - homogOutput, & - crystalliteOutput, & - phaseOutput - use numerics, only: & - integrationOrder - use FEM_utilities, only: & - resUnit, & - coordinatesVec, & - homogenizationResultsVec, & - crystalliteResultsVec, & - phaseResultsVec - - implicit none - integer(pInt), intent(in) :: inc - type(tFieldBC),intent(in) :: fieldBC - DM :: dm_local - PetscDS :: prob - Vec :: localVec - PetscScalar, dimension(:), pointer :: x_scal, coordinates, results - PetscSection :: section - PetscReal, pointer :: basisField(:), basisFieldDer(:) - PetscInt :: nodeStart, nodeEnd, node - PetscInt :: faceStart, faceEnd, face - PetscInt :: cellStart, cellEnd, cell - PetscInt :: field, qPt, qOffset, fOffset, dim, gType, cSize - PetscInt :: homog, cryst, grain, phase, res, resSize - PetscErrorCode :: ierr - character(len=1024) :: resultPartition, incPartition, homogPartition, & - crystPartition, phasePartition, & - grainStr - integer(pInt) :: ctr - - write(incPartition,'(a11,i0)') '/Increment_',inc - call PetscViewerHDF5PushGroup(resUnit, trim(incPartition), ierr); CHKERRQ(ierr) - call SNESGetDM(mech_snes,dm_local,ierr); CHKERRQ(ierr) !< retrieve mesh info from mech_snes into dm_local - call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) !< retrieve discretization from mesh and store in prob - call DMGetDefaultSection(dm_local,section,ierr); CHKERRQ(ierr) !< retrieve section (degrees of freedom) - call DMGetLocalVector(dm_local,localVec,ierr); CHKERRQ(ierr) !< retrieve local vector - call VecCopy(solution_local,localVec,ierr); CHKERRQ(ierr) - - call VecGetArrayF90(coordinatesVec, coordinates, ierr); CHKERRQ(ierr) - ctr = 1_pInt - select case (integrationOrder) - case(1_pInt) !< first order quadrature - call DMPlexGetDepthStratum(dm_local,0,nodeStart,nodeEnd,ierr); CHKERRQ(ierr) !< get index range of entities at dimension 0 (i.e., all nodes) - do node = nodeStart, nodeEnd-1 !< loop over all nodes in mesh - call DMPlexVecGetClosure(dm_local,section,localVec,node,x_scal,ierr) !< x_scal = localVec (i.e. solution) at node - CHKERRQ(ierr) - do dim = 1, dimPlex - coordinates(ctr) = x_scal(dim); ctr = ctr + 1_pInt !< coordinates of node - enddo - call DMPlexVecRestoreClosure(dm_local,section,localVec,node,x_scal,ierr) !< disassociate x_scal pointer - CHKERRQ(ierr) - enddo - case(2_pInt) !< second order quadrature - call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr) !< get index range of highest dimension object (i.e. cells of mesh) TODO 3D assumption!! - CHKERRQ(ierr) - do cell = cellStart, cellEnd-1 !< loop over all elements - call DMPlexVecGetClosure(dm_local,section,localVec,cell,x_scal,ierr) - CHKERRQ(ierr) - do dim = 1, dimPlex - coordinates(ctr) = sum(x_scal(dim:cellDof:dimPlex))/real(nBasis) !< coordinates of cell center - ctr = ctr + 1_pInt - enddo - call DMPlexVecRestoreClosure(dm_local,section,localVec,cell,x_scal,ierr) - CHKERRQ(ierr) - enddo - call DMPlexGetDepthStratum(dm_local,0,nodeStart,nodeEnd,ierr) !< get index range of entities at dimension 0 (i.e., all nodes) - CHKERRQ(ierr) - do node = nodeStart, nodeEnd-1 !< loop over all nodes - call DMPlexVecGetClosure(dm_local,section,localVec,node,x_scal,ierr) - CHKERRQ(ierr) - do dim = 1, dimPlex - coordinates(ctr) = x_scal(dim) !< coordinates of cell corners - ctr = ctr + 1_pInt - enddo - call DMPlexVecRestoreClosure(dm_local,section,localVec,node,x_scal,ierr) - CHKERRQ(ierr) - enddo - do gType = 1, dimPlex-1 - call DMPlexGetHeightStratum(dm_local,gType,faceStart,faceEnd,ierr) !< get index range of entities at dimension N-1 (i.e., all faces) - CHKERRQ(ierr) - do face = faceStart, faceEnd-1 !< loop over all elements - call DMPlexVecGetClosure(dm_local,section,localVec,face,x_scal,ierr) - CHKERRQ(ierr) - cSize = size(x_scal) - do dim = 1, dimPlex - coordinates(ctr) = sum(x_scal(dim:cSize:dimPlex))/real(cSize/dimPlex) !< coordinates of edge/face centers TODO quadratic element assumption used here! - ctr = ctr + 1_pInt - enddo - call DMPlexVecRestoreClosure(dm_local,section,localVec,face,x_scal,ierr) - CHKERRQ(ierr) - enddo - enddo - case default - call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr) !< get index range of elements (mesh cells) - CHKERRQ(ierr) - do cell = cellStart, cellEnd-1 !< loop over all elements - call DMPlexVecGetClosure(dm_local, & !< mesh - section, & !< distribution of DoF on mesh - localVec, & !< overall solution vector (i.e. all DoFs)... - cell, & !< ...at this cell - x_scal, & !< store all DoFs of closure (faces, edges, nodes if present) into x_scal - ierr) !< --> get coordinates of closure entities with DoFs - CHKERRQ(ierr) - qOffset = 0 - do qPt = 1, nQuadrature !< loop over each quad point in cell - fOffset = 0 - do field = 0, dimPlex-1 !< loop over each solution field (e.g., x,y,z coordinates) - call PetscDSGetTabulation(prob,field,basisField,basisFieldDer,ierr) !< retrieve shape function at each quadrature point for field - CHKERRQ(ierr) - coordinates(ctr) = real(sum(basisField(qOffset+1:qOffset+nBasis)* & - x_scal(fOffset+1:fOffset+nBasis)), pReal) !< interpolate field value (in x_scal) to quad points - ctr = ctr + 1_pInt - fOffset = fOffset + nBasis !< wind forward by one field - enddo - qOffset = qOffset + nBasis !< wind forward by one quad point - enddo - call DMPlexVecRestoreClosure(dm_local,section,localVec,cell,x_scal,ierr) - CHKERRQ(ierr) - enddo - end select - call VecRestoreArrayF90(coordinatesVec, coordinates, ierr); CHKERRQ(ierr) - call VecAssemblyBegin(coordinatesVec, ierr); CHKERRQ(ierr) - call VecAssemblyEnd (coordinatesVec, ierr); CHKERRQ(ierr) - call VecView(coordinatesVec, resUnit, ierr); CHKERRQ(ierr) - call DMRestoreLocalVector(dm_local,localVec,ierr); CHKERRQ(ierr) - - do homog = 1, material_Nhomogenization - call VecGetSize(homogenizationResultsVec(homog),resSize,ierr) - if (resSize > 0) then - homogPartition = trim(incPartition)//'/Homog_'//trim(homogenization_name(homog)) - call PetscViewerHDF5PushGroup(resUnit, homogPartition, ierr) - CHKERRQ(ierr) - do res = 1, homogOutput(homog)%sizeResults - write(resultPartition,'(a12,i0)') 'homogResult_',res - call PetscObjectSetName(homogenizationResultsVec(homog),trim(resultPartition),ierr) - CHKERRQ(ierr) - call VecGetArrayF90(homogenizationResultsVec(homog),results,ierr);CHKERRQ(ierr) - results = homogOutput(homog)%output(res,:) - call VecRestoreArrayF90(homogenizationResultsVec(homog), results, ierr) - CHKERRQ(ierr) - call VecAssemblyBegin(homogenizationResultsVec(homog), ierr); CHKERRQ(ierr) - call VecAssemblyEnd (homogenizationResultsVec(homog), ierr); CHKERRQ(ierr) - call VecView(homogenizationResultsVec(homog), resUnit, ierr); CHKERRQ(ierr) - enddo - call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr) - endif - enddo - do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains - call VecGetSize(crystalliteResultsVec(cryst,grain),resSize,ierr) - if (resSize > 0) then - write(grainStr,'(a,i0)') 'Grain',grain - crystPartition = trim(incPartition)//'/Crystallite_'//trim(crystallite_name(cryst))//'_'//trim(grainStr) - call PetscViewerHDF5PushGroup(resUnit, crystPartition, ierr) - CHKERRQ(ierr) - do res = 1, crystalliteOutput(cryst,grain)%sizeResults - write(resultPartition,'(a18,i0)') 'crystalliteResult_',res - call PetscObjectSetName(crystalliteResultsVec(cryst,grain),trim(resultPartition),ierr) - CHKERRQ(ierr) - call VecGetArrayF90(crystalliteResultsVec(cryst,grain),results,ierr) - CHKERRQ(ierr) - results = crystalliteOutput(cryst,grain)%output(res,:) - call VecRestoreArrayF90(crystalliteResultsVec(cryst,grain), results, ierr) - CHKERRQ(ierr) - call VecAssemblyBegin(crystalliteResultsVec(cryst,grain), ierr);CHKERRQ(ierr) - call VecAssemblyEnd (crystalliteResultsVec(cryst,grain), ierr);CHKERRQ(ierr) - call VecView(crystalliteResultsVec(cryst,grain), resUnit, ierr);CHKERRQ(ierr) - enddo - call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr) - endif - enddo; enddo - do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains - call VecGetSize(phaseResultsVec(phase,grain),resSize,ierr) - if (resSize > 0) then - write(grainStr,'(a,i0)') 'Grain',grain - phasePartition = trim(incPartition)//'/Phase_'//trim(phase_name(phase))//'_'//trim(grainStr) - call PetscViewerHDF5PushGroup(resUnit, phasePartition, ierr) - CHKERRQ(ierr) - do res = 1, phaseOutput(phase,grain)%sizeResults - write(resultPartition,'(a12,i0)') 'phaseResult_',res - call PetscObjectSetName(phaseResultsVec(phase,grain),trim(resultPartition),ierr) - CHKERRQ(ierr) - call VecGetArrayF90(phaseResultsVec(phase,grain),results,ierr);CHKERRQ(ierr) - results = phaseOutput(phase,grain)%output(res,:) - call VecRestoreArrayF90(phaseResultsVec(phase,grain), results, ierr) - CHKERRQ(ierr) - call VecAssemblyBegin(phaseResultsVec(phase,grain), ierr); CHKERRQ(ierr) - call VecAssemblyEnd (phaseResultsVec(phase,grain), ierr); CHKERRQ(ierr) - call VecView(phaseResultsVec(phase,grain), resUnit, ierr); CHKERRQ(ierr) - enddo - call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr) - endif - enddo; enddo - -end subroutine FEM_mech_output !-------------------------------------------------------------------------------------------------- !> @brief destroy routine diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index e16047da6..1b1c33b3a 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -3,8 +3,7 @@ !> @brief Utilities used by the FEM solver !-------------------------------------------------------------------------------------------------- module FEM_utilities -#include -#include +#include use prec, only: pReal, pInt use PETScdmda @@ -12,7 +11,6 @@ use PETScis implicit none private -#include !-------------------------------------------------------------------------------------------------- ! logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill @@ -187,14 +185,9 @@ subroutine utilities_init() use mesh, only: & mesh_NcpElemsGlobal, & mesh_maxNips, & - geomMesh, & - mesh_element + geomMesh use material, only: & - homogenization_Ngrains, & - homogenization_maxNgrains, & - material_homog, & - material_phase, & - microstructure_crystallite + material_homog implicit none @@ -204,17 +197,13 @@ subroutine utilities_init() PetscInt, dimension(:), pointer :: points PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:), mappingCells(:) PetscInt :: cellStart, cellEnd, cell, ip, dim, ctr, qPt - PetscInt :: homog, cryst, grain, phase PetscInt, allocatable :: connectivity(:,:) Vec :: connectivityVec - PetscScalar, dimension(:), pointer :: results PetscErrorCode :: ierr - if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif !-------------------------------------------------------------------------------------------------- ! set debugging parameters @@ -738,8 +727,8 @@ end subroutine utilities_indexActiveSet !> @brief cleans up !-------------------------------------------------------------------------------------------------- subroutine utilities_destroy() - use material, only: & - homogenization_Ngrains + !use material, only: & + ! homogenization_Ngrains !implicit none !PetscInt :: homog, cryst, grain, phase From f7c20d74afaadb23d5d3e46a6a650b18d662c634 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 Aug 2018 15:58:42 +0200 Subject: [PATCH 120/208] compiles now, but most likely does not work --- src/CMakeLists.txt | 6 +- src/DAMASK_FEM.f90 | 837 ++++++++++++++++++++++----------------------- src/FEM_mech.f90 | 9 +- 3 files changed, 423 insertions(+), 429 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index caaf0b893..43381532b 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -175,20 +175,24 @@ if (PROJECT_NAME STREQUAL "DAMASK_spectral") "spectral_mech_Basic.f90") add_dependencies(SPECTRAL_SOLVER SPECTRAL_UTILITIES) list(APPEND OBJECTFILES $) + if(NOT CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY") add_executable(DAMASK_spectral "DAMASK_spectral.f90" ${OBJECTFILES}) else() add_library(DAMASK_spectral OBJECT "DAMASK_spectral.f90") endif() + add_dependencies(DAMASK_spectral SPECTRAL_SOLVER) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEM_UTILITIES OBJECT "FEM_utilities.f90") add_dependencies(FEM_UTILITIES DAMASK_CPFE) + list(APPEND OBJECTFILES $) add_library(FEM_SOLVER OBJECT "FEM_mech.f90") add_dependencies(FEM_SOLVER FEM_UTILITIES) + list(APPEND OBJECTFILES $) - add_executable(DAMASK_FEM "DAMASK_FEM.f90") + add_executable(DAMASK_FEM "DAMASK_FEM.f90" ${OBJECTFILES}) add_dependencies(DAMASK_FEM FEM_SOLVER) endif() diff --git a/src/DAMASK_FEM.f90 b/src/DAMASK_FEM.f90 index 60134f861..b0f6e5d97 100644 --- a/src/DAMASK_FEM.f90 +++ b/src/DAMASK_FEM.f90 @@ -2,30 +2,20 @@ !> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Driver controlling inner and outer load case looping of the various FEM solvers +!> @brief Driver controlling inner and outer load case looping of the FEM solver !> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing !> results !-------------------------------------------------------------------------------------------------- -program DAMASK_FEM -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif -#include - use PETScsys +program DAMASK_FEM + use, intrinsic :: & + iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) use prec, only: & pInt, & - pLongInt, & pReal, & - tol_math_check, & - dNeq - use system_routines, only: & - getCWD + tol_math_check use DAMASK_interface, only: & DAMASK_interface_init, & loadCaseFile, & - geometryFile, & getSolverJobName, & appendToOutFile use IO, only: & @@ -47,110 +37,120 @@ program DAMASK_FEM debug_spectral, & debug_levelBasic use math ! need to include the whole module for FFTW - use mesh, only: & - grid, & - geomSize use CPFEM2, only: & CPFEM_initAll use FEsolving, only: & restartWrite, & restartInc use numerics, only: & - worldrank, & - worldsize, & - stagItMax, & maxCutBack, & - spectral_solver, & - continueCalculation - use homogenization, only: & - materialpoint_sizeResults, & - materialpoint_results, & - materialpoint_postResults - use material, only: & - thermal_type, & - damage_type, & - THERMAL_conduction_ID, & - DAMAGE_nonlocal_ID - use FEM_utilities + stagItMax, & + worldrank + use mesh, only: & + mesh_Nboundaries, & + mesh_boundaries, & + geomMesh + use FEM_Utilities, only: & + utilities_init, & + tSolutionState, & + tLoadCase, & + cutBack, & + maxFields, & + nActiveFields, & + FIELD_MECH_ID, & + FIELD_THERMAL_ID, & + FIELD_DAMAGE_ID, & + FIELD_SOLUTE_ID, & + FIELD_MGTWIN_ID, & + COMPONENT_MECH_X_ID, & + COMPONENT_MECH_Y_ID, & + COMPONENT_MECH_Z_ID, & + COMPONENT_THERMAL_T_ID, & + COMPONENT_DAMAGE_PHI_ID, & + COMPONENT_SOLUTE_CV_ID, & + COMPONENT_SOLUTE_CVPOT_ID, & + COMPONENT_SOLUTE_CH_ID, & + COMPONENT_SOLUTE_CHPOT_ID, & + COMPONENT_SOLUTE_CVaH_ID, & + COMPONENT_SOLUTE_CVaHPOT_ID, & + COMPONENT_MGTWIN_PHI_ID, & + FIELD_MECH_label, & + FIELD_THERMAL_label, & + FIELD_DAMAGE_label, & + FIELD_SOLUTE_label, & + FIELD_MGTWIN_label use FEM_mech - + implicit none +#include !-------------------------------------------------------------------------------------------------- ! variables related to information from load case and geom file - real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0) - logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors - integer(pInt), parameter :: FILEUNIT = 234_pInt !< file unit, DAMASK IO does not support newunit feature - integer(pInt), allocatable, dimension(:) :: chunkPos - + integer(pInt), parameter :: FILEUNIT = 234_pInt !< file unit, DAMASK IO does not support newunit feature + integer(pInt), allocatable, dimension(:) :: chunkPos ! this is longer than needed for geometry parsing + integer(pInt) :: & - N_t = 0_pInt, & !< # of time indicators found in load case file - N_n = 0_pInt, & !< # of increment specifiers found in load case file N_def = 0_pInt !< # of rate of deformation specifiers found in load case file character(len=65536) :: & line !-------------------------------------------------------------------------------------------------- ! loop variables, convergence etc. - real(pReal), dimension(3,3), parameter :: & - ones = 1.0_pReal, & - zeros = 0.0_pReal + integer(pInt), parameter :: & subStepFactor = 2_pInt !< for each substep, divide the last time increment by 2.0 real(pReal) :: & time = 0.0_pReal, & !< elapsed time time0 = 0.0_pReal, & !< begin of interval - timeinc = 1.0_pReal, & !< current time interval + timeinc = 0.0_pReal, & !< current time interval timeIncOld = 0.0_pReal, & !< previous time interval remainingLoadCaseTime = 0.0_pReal !< remaining time of current load case logical :: & - guess, & !< guess along former trajectory - stagIterate + guess !< guess along former trajectory integer(pInt) :: & - i, j, k, l, field, & + i, & errorID, & cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ stepFraction = 0_pInt !< fraction of current time interval integer(pInt) :: & currentLoadcase = 0_pInt, & !< current load case + currentFace = 0_pInt, & inc, & !< current increment in current load case - totalIncsCounter = 0_pInt, & !< total # of increments - convergedCounter = 0_pInt, & !< # of converged increments - notConvergedCounter = 0_pInt, & !< # of non-converged increments - resUnit = 0_pInt, & !< file unit for results writing + totalIncsCounter = 0_pInt, & !< total No. of increments + convergedCounter = 0_pInt, & !< No. of converged increments + notConvergedCounter = 0_pInt, & !< No. of non-converged increments statUnit = 0_pInt, & !< file unit for statistics output - lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written - stagIter + lastRestartWritten = 0_pInt !< total increment No. at which last restart information was written + integer(pInt) :: & + stagIter, & + component + logical :: & + stagIterate character(len=6) :: loadcase_string - character(len=1024) :: & - incInfo, & !< string parsed to solution with information about current load case - workingDir + character(len=1024) :: incInfo !< string parsed to solution with information about current load case type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases type(tSolutionState), allocatable, dimension(:) :: solres - integer(MPI_OFFSET_KIND) :: fileOffset - integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize - integer(pInt), parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742 - integer(pInt), parameter :: maxRealOut = maxByteOut/pReal - integer(pLongInt), dimension(2) :: outputIndex - integer :: ierr + PetscInt :: faceSet, currentFaceSet + PetscInt :: field, dimPlex + PetscErrorCode :: ierr external :: & + MPI_abort, & + DMGetDimension, & + DMGetLabelSize, & + DMGetLabelIdIS, & + ISDestroy, & quit - - !-------------------------------------------------------------------------------------------------- ! init DAMASK (all modules) call CPFEM_initAll(el = 1_pInt, ip = 1_pInt) - write(6,'(/,a)') ' <<<+- DAMASK_spectral init -+>>>' - write(6,'(/,a,/)') ' Roters et al., Computational Materials Science, 2018' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- DAMASK_FEM init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - -!-------------------------------------------------------------------------------------------------- -! initialize field solver information + +! reading basic information from load case file and allocate data structure containing load cases + call DMGetDimension(geomMesh,dimPlex,ierr)! CHKERRQ(ierr) !< dimension of mesh (2D or 3D) nActiveFields = 1 - if (any(thermal_type == THERMAL_conduction_ID )) nActiveFields = nActiveFields + 1 - if (any(damage_type == DAMAGE_nonlocal_ID )) nActiveFields = nActiveFields + 1 allocate(solres(nActiveFields)) !-------------------------------------------------------------------------------------------------- @@ -162,37 +162,36 @@ program DAMASK_FEM if (trim(line) == IO_EOF) exit if (IO_isBlank(line)) cycle ! skip empty lines chunkPos = IO_stringPos(line) - do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase + do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase select case (IO_lc(IO_stringValue(line,chunkPos,i))) - case('l','velocitygrad','velgrad','velocitygradient','fdot','dotf','f') + case('$loadcase') N_def = N_def + 1_pInt - case('t','time','delta') - N_t = N_t + 1_pInt - case('n','incs','increments','steps','logincs','logincrements','logsteps') - N_n = N_n + 1_pInt end select enddo ! count all identifiers to allocate memory and do sanity check enddo - if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check - call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase - allocate (loadCases(N_n)) ! array of load cases - loadCases%stress%myType='stress' + allocate (loadCases(N_def)) - do i = 1, size(loadCases) - allocate(loadCases(i)%ID(nActiveFields)) + do i = 1, size(loadCases) + allocate(loadCases(i)%fieldBC(nActiveFields)) field = 1 - loadCases(i)%ID(field) = FIELD_MECH_ID ! mechanical active by default - thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then - field = field + 1 - loadCases(i)%ID(field) = FIELD_THERMAL_ID - endif thermalActive - damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then - field = field + 1 - loadCases(i)%ID(field) = FIELD_DAMAGE_ID - endif damageActive + loadCases(i)%fieldBC(field)%ID = FIELD_MECH_ID enddo + do i = 1, size(loadCases) + do field = 1, nActiveFields + select case (loadCases(i)%fieldBC(field)%ID) + case(FIELD_MECH_ID) + loadCases(i)%fieldBC(field)%nComponents = dimPlex !< X, Y (, Z) displacements + allocate(loadCases(i)%fieldBC(field)%componentBC(loadCases(i)%fieldBC(field)%nComponents)) + end select + do component = 1, loadCases(i)%fieldBC(field)%nComponents + allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pReal) + allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.) + enddo + enddo + enddo + !-------------------------------------------------------------------------------------------------- ! reading the load case and assign values to the allocated data structure rewind(FILEUNIT) @@ -200,39 +199,20 @@ program DAMASK_FEM line = IO_read(FILEUNIT) if (trim(line) == IO_EOF) exit if (IO_isBlank(line)) cycle ! skip empty lines - currentLoadCase = currentLoadCase + 1_pInt chunkPos = IO_stringPos(line) do i = 1_pInt, chunkPos(1) select case (IO_lc(IO_stringValue(line,chunkPos,i))) - case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f') ! assign values for the deformation BC matrix - temp_valueVector = 0.0_pReal - if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'fdot'.or. & ! in case of Fdot, set type to fdot - IO_lc(IO_stringValue(line,chunkPos,i)) == 'dotf') then - loadCases(currentLoadCase)%deformation%myType = 'fdot' - else if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'f') then - loadCases(currentLoadCase)%deformation%myType = 'f' - else - loadCases(currentLoadCase)%deformation%myType = 'l' - endif - do j = 1_pInt, 9_pInt - temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not a * - if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable +!-------------------------------------------------------------------------------------------------- +! loadcase information + case('$loadcase') + currentLoadCase = IO_intValue(line,chunkPos,i+1_pInt) + case('face') + currentFace = IO_intValue(line,chunkPos,i+1_pInt) + currentFaceSet = -1_pInt + do faceSet = 1, mesh_Nboundaries + if (mesh_boundaries(faceSet) == currentFace) currentFaceSet = faceSet enddo - loadCases(currentLoadCase)%deformation%maskLogical = & ! logical mask in 3x3 notation - transpose(reshape(temp_maskVector,[ 3,3])) - loadCases(currentLoadCase)%deformation%maskFloat = & ! float (1.0/0.0) mask in 3x3 notation - merge(ones,zeros,loadCases(currentLoadCase)%deformation%maskLogical) - loadCases(currentLoadCase)%deformation%values = math_plain9to33(temp_valueVector) ! values in 3x3 notation - case('p','pk1','piolakirchhoff','stress', 's') - temp_valueVector = 0.0_pReal - do j = 1_pInt, 9_pInt - temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk - if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable - enddo - loadCases(currentLoadCase)%stress%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) - loadCases(currentLoadCase)%stress%maskFloat = merge(ones,zeros,& - loadCases(currentLoadCase)%stress%maskLogical) - loadCases(currentLoadCase)%stress%values = math_plain9to33(temp_valueVector) + if (currentFaceSet < 0_pInt) call IO_error(error_ID = errorID, ext_msg = 'invalid BC') case('t','time','delta') ! increment time loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt) case('n','incs','increments','steps') ! number of increments @@ -241,34 +221,172 @@ program DAMASK_FEM loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) loadCases(currentLoadCase)%logscale = 1_pInt case('freq','frequency','outputfreq') ! frequency of result writings - loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) + loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) case('r','restart','restartwrite') ! frequency of writing restart information loadCases(currentLoadCase)%restartfrequency = & - max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt)) + max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt)) case('guessreset','dropguessing') loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory - case('euler') ! rotation of currentLoadCase given in euler angles - temp_valueVector = 0.0_pReal - l = 1_pInt ! assuming values given in degrees - k = 1_pInt ! assuming keyword indicating degree/radians present - select case (IO_lc(IO_stringValue(line,chunkPos,i+1_pInt))) - case('deg','degree') - case('rad','radian') ! don't convert from degree to radian - l = 0_pInt - case default - k = 0_pInt - end select - do j = 1_pInt, 3_pInt - temp_valueVector(j) = IO_floatValue(line,chunkPos,i+k+j) - enddo - if (l == 1_pInt) temp_valueVector(1:3) = temp_valueVector(1:3) * inRad ! convert to rad - loadCases(currentLoadCase)%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix - case('rotation','rot') ! assign values for the rotation of currentLoadCase matrix - temp_valueVector = 0.0_pReal - do j = 1_pInt, 9_pInt - temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) - enddo - loadCases(currentLoadCase)%rotation = math_plain9to33(temp_valueVector) + +!-------------------------------------------------------------------------------------------------- +! boundary condition information + case('x') ! X displacement field + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_X_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('y') ! Y displacement field + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Y_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('z') ! Z displacement field + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Z_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('temp','temperature') ! thermal field + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_THERMAL_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_THERMAL_T_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('mgtwin') ! mgtwin field + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MGTWIN_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MGTWIN_PHI_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('damage') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_DAMAGE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_DAMAGE_PHI_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('cv') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CV_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('cvpot') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CVPOT_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('ch') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CH_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('chpot') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CHPOT_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('cvah') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CVaH_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('cvahpot') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CVaHPOT_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + end select enddo; enddo close(FILEUNIT) @@ -283,382 +401,255 @@ program DAMASK_FEM write(6,'(1x,a,i6)') 'load case: ', currentLoadCase if (.not. loadCases(currentLoadCase)%followFormerTrajectory) & write(6,'(2x,a)') 'drop guessing along trajectory' - if (loadCases(currentLoadCase)%deformation%myType == 'l') then - do j = 1_pInt, 3_pInt - if (any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .true.) .and. & - any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .false.)) & - errorID = 832_pInt ! each row should be either fully or not at all defined - enddo - write(6,'(2x,a)') 'velocity gradient:' - else if (loadCases(currentLoadCase)%deformation%myType == 'f') then - write(6,'(2x,a)') 'deformation gradient at end of load case:' - else - write(6,'(2x,a)') 'deformation gradient rate:' - endif - do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt - if(loadCases(currentLoadCase)%deformation%maskLogical(i,j)) then - write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%deformation%values(i,j) - else - write(6,'(2x,12a)',advance='no') ' * ' - endif - enddo; write(6,'(/)',advance='no') + do field = 1_pInt, nActiveFields + select case (loadCases(currentLoadCase)%fieldBC(field)%ID) + case(FIELD_MECH_ID) + write(6,'(2x,a)') 'Field '//trim(FIELD_MECH_label) + + case(FIELD_THERMAL_ID) + write(6,'(2x,a)') 'Field '//trim(FIELD_THERMAL_label) + + case(FIELD_DAMAGE_ID) + write(6,'(2x,a)') 'Field '//trim(FIELD_DAMAGE_label) + + case(FIELD_MGTWIN_ID) + write(6,'(2x,a)') 'Field '//trim(FIELD_MGTWIN_label) + + case(FIELD_SOLUTE_ID) + write(6,'(2x,a)') 'Field '//trim(FIELD_SOLUTE_label) + + end select + do faceSet = 1_pInt, mesh_Nboundaries + do component = 1_pInt, loadCases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) & + write(6,'(4x,a,i2,a,i2,a,f12.7)') 'Face ', mesh_boundaries(faceSet), & + ' Component ', component, & + ' Value ', loadCases(currentLoadCase)%fieldBC(field)% & + componentBC(component)%Value(faceSet) + enddo + enddo enddo - if (any(loadCases(currentLoadCase)%stress%maskLogical .eqv. & - loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only - if (any(loadCases(currentLoadCase)%stress%maskLogical .and. & - transpose(loadCases(currentLoadCase)%stress%maskLogical) .and. & - reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) & - errorID = 838_pInt ! no rotation is allowed by stress BC - write(6,'(2x,a)') 'stress / GPa:' - do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt - if(loadCases(currentLoadCase)%stress%maskLogical(i,j)) then - write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%stress%values(i,j)*1e-9_pReal - else - write(6,'(2x,12a)',advance='no') ' * ' - endif - enddo; write(6,'(/)',advance='no') - enddo - if (any(abs(math_mul33x33(loadCases(currentLoadCase)%rotation, & - math_transpose33(loadCases(currentLoadCase)%rotation))-math_I3) > & - reshape(spread(tol_math_check,1,9),[ 3,3]))& - .or. abs(math_det33(loadCases(currentLoadCase)%rotation)) > & - 1.0_pReal + tol_math_check) errorID = 846_pInt ! given rotation matrix contains strain - if (any(dNeq(loadCases(currentLoadCase)%rotation, math_I3))) & - write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',& - math_transpose33(loadCases(currentLoadCase)%rotation) - if (loadCases(currentLoadCase)%time < 0.0_pReal) errorID = 834_pInt ! negative time increment write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time - if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count + if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs - if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency + if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency write(6,'(2x,a,i5)') 'output frequency: ', & loadCases(currentLoadCase)%outputfrequency - write(6,'(2x,a,i5,/)') 'restart frequency: ', & + write(6,'(2x,a,i5,/)') 'restart frequency: ', & loadCases(currentLoadCase)%restartfrequency - if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message + if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message enddo checkLoadcases endif !-------------------------------------------------------------------------------------------------- -! doing initialization depending on selected solver +! doing initialization depending on selected solver call Utilities_init() do field = 1, nActiveFields - select case (loadCases(1)%ID(field)) + select case (loadCases(1)%fieldBC(field)%ID) case(FIELD_MECH_ID) - select case (spectral_solver) - case (DAMASK_spectral_SolverBasic_label) - call basic_init - - case (DAMASK_spectral_SolverPolarisation_label) - if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & - call IO_warning(42_pInt, ext_msg='debug Divergence') - call Polarisation_init - - case default - call IO_error(error_ID = 891_pInt, ext_msg = trim(spectral_solver)) - - end select - - case(FIELD_THERMAL_ID) - call spectral_thermal_init - - case(FIELD_DAMAGE_ID) - call spectral_damage_init() - + call FEM_mech_init(loadCases(1)%fieldBC(field)) end select - enddo + enddo !-------------------------------------------------------------------------------------------------- -! write header of output file - if (worldrank == 0) then - if (.not. appendToOutFile) then ! after restart, append to existing results file - if (getCWD(workingDir)) call IO_error(106_pInt,ext_msg=trim(workingDir)) - open(newunit=resUnit,file=trim(getSolverJobName())//& - '.spectralOut',form='UNFORMATTED',status='REPLACE') - write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header - write(resUnit) 'workingdir:', trim(workingDir) - write(resUnit) 'geometry:', trim(geometryFile) - write(resUnit) 'grid:', grid - write(resUnit) 'size:', geomSize - write(resUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults - write(resUnit) 'loadcases:', size(loadCases) - write(resUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase - write(resUnit) 'times:', loadCases%time ! one entry per LoadCase - write(resUnit) 'logscales:', loadCases%logscale - write(resUnit) 'increments:', loadCases%incs ! one entry per LoadCase - write(resUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc - write(resUnit) 'eoh' - close(resUnit) ! end of header - open(newunit=statUnit,file=trim(getSolverJobName())//& - '.sta',form='FORMATTED',status='REPLACE') - write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file - if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) & - write(6,'(/,a)') ' header of result and statistics file written out' - flush(6) - else ! open new files ... - open(newunit=statUnit,file=trim(getSolverJobName())//& - '.sta',form='FORMATTED', position='APPEND', status='OLD') - endif - endif - -!-------------------------------------------------------------------------------------------------- -! looping over loadcases +! loopping over loadcases loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) - time0 = time ! currentLoadCase start time - guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc + time0 = time ! currentLoadCase start time + if (loadCases(currentLoadCase)%followFormerTrajectory) then + guess = .true. + else + guess = .false. ! change of load case, homogeneous guess for the first inc + endif !-------------------------------------------------------------------------------------------------- -! loop over incs defined in input file for current currentLoadCase +! loop oper incs defined in input file for current currentLoadCase incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs - totalIncsCounter = totalIncsCounter + 1_pInt + totalIncsCounter = totalIncsCounter + 1_pInt !-------------------------------------------------------------------------------------------------- ! forwarding time - timeIncOld = timeinc ! last timeinc that brought former inc to an end + timeIncOld = timeinc if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale - timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal) + timeinc = loadCases(currentLoadCase)%time/loadCases(currentLoadCase)%incs ! only valid for given linear time scale. will be overwritten later in case loglinear scale is used else - if (currentLoadCase == 1_pInt) then ! 1st currentLoadCase of logarithmic scale + if (currentLoadCase == 1_pInt) then ! 1st currentLoadCase of logarithmic scale if (inc == 1_pInt) then ! 1st inc of 1st currentLoadCase of logarithmic scale - timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd + timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd else ! not-1st inc of 1st currentLoadCase of logarithmic scale timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal)) endif else ! not-1st currentLoadCase of logarithmic scale timeinc = time0 * & - ( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc ,pReal)/& + ( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc,pReal)/& real(loadCases(currentLoadCase)%incs ,pReal))& - -(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1_pInt ,pReal)/& - real(loadCases(currentLoadCase)%incs ,pReal))) + -(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( (inc-1_pInt),pReal)/& + real(loadCases(currentLoadCase)%incs ,pReal))) endif endif - timeinc = timeinc * real(subStepFactor,pReal)**real(-cutBackLevel,pReal) ! depending on cut back level, decrease time step + timeinc = timeinc / 2.0_pReal**real(cutBackLevel,pReal) ! depending on cut back level, decrease time step - skipping: if (totalIncsCounter <= restartInc) then ! not yet at restart inc? - time = time + timeinc ! just advance time, skip already performed calculation - guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference - else skipping - stepFraction = 0_pInt ! fraction scaled by stepFactor**cutLevel + forwarding: if(totalIncsCounter >= restartInc) then + stepFraction = 0_pInt !-------------------------------------------------------------------------------------------------- -! loop over sub step - subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel) - remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time - time = time + timeinc ! forward target time - stepFraction = stepFraction + 1_pInt ! count step - +! loop over sub incs + subIncLooping: do while (stepFraction/subStepFactor**cutBackLevel <1_pInt) + time = time + timeinc ! forward time + stepFraction = stepFraction + 1_pInt + remainingLoadCaseTime = time0 - time + loadCases(currentLoadCase)%time + timeInc + !-------------------------------------------------------------------------------------------------- -! report begin of new step - write(6,'(/,a)') ' ###########################################################################' - write(6,'(1x,a,es12.5'//& - ',a,'//IO_intOut(inc) //',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//& - ',a,'//IO_intOut(stepFraction) //',a,'//IO_intOut(subStepFactor**cutBackLevel)//& - ',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') & - 'Time', time, & - 's: Increment ', inc,'/',loadCases(currentLoadCase)%incs,& - '-', stepFraction,'/',subStepFactor**cutBackLevel,& - ' of load case ', currentLoadCase,'/',size(loadCases) - write(incInfo,& - '(a,'//IO_intOut(totalIncsCounter)//& - ',a,'//IO_intOut(sum(loadCases%incs))//& - ',a,'//IO_intOut(stepFraction)//& - ',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') & +! report begin of new increment + if (worldrank == 0) then + write(6,'(/,a)') ' ###########################################################################' + write(6,'(1x,a,es12.5'//& + ',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//& + ',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//& + ',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') & + 'Time', time, & + 's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,& + '-', stepFraction, '/', subStepFactor**cutBackLevel,& + ' of load case ', currentLoadCase,'/',size(loadCases) + flush(6) + write(incInfo,'(a,'//IO_intOut(totalIncsCounter)//',a,'//IO_intOut(sum(loadCases%incs))//& + ',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') & 'Increment ',totalIncsCounter,'/',sum(loadCases%incs),& - '-', stepFraction,'/',subStepFactor**cutBackLevel - flush(6) + '-',stepFraction, '/', subStepFactor**cutBackLevel + endif !-------------------------------------------------------------------------------------------------- ! forward fields do field = 1, nActiveFields - select case(loadCases(currentLoadCase)%ID(field)) + select case (loadCases(currentLoadCase)%fieldBC(field)%ID) case(FIELD_MECH_ID) - select case (spectral_solver) - case (DAMASK_spectral_SolverBasic_label) - call Basic_forward (& - guess,timeinc,timeIncOld,remainingLoadCaseTime, & - deformation_BC = loadCases(currentLoadCase)%deformation, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) - - case (DAMASK_spectral_SolverPolarisation_label) - call Polarisation_forward (& - guess,timeinc,timeIncOld,remainingLoadCaseTime, & - deformation_BC = loadCases(currentLoadCase)%deformation, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) - end select - - case(FIELD_THERMAL_ID); call spectral_thermal_forward() - case(FIELD_DAMAGE_ID); call spectral_damage_forward() - end select - enddo + call FEM_mech_forward (& + guess,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field)) + end select + enddo + !-------------------------------------------------------------------------------------------------- ! solve fields stagIter = 0_pInt stagIterate = .true. do while (stagIterate) do field = 1, nActiveFields - select case(loadCases(currentLoadCase)%ID(field)) + select case (loadCases(currentLoadCase)%fieldBC(field)%ID) case(FIELD_MECH_ID) - select case (spectral_solver) - case (DAMASK_spectral_SolverBasic_label) - solres(field) = Basic_solution (& - incInfo,timeinc,timeIncOld, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) - - case (DAMASK_spectral_SolverPolarisation_label) - solres(field) = Polarisation_solution (& - incInfo,timeinc,timeIncOld, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) - - end select - - case(FIELD_THERMAL_ID) - solres(field) = spectral_thermal_solution(timeinc,timeIncOld,remainingLoadCaseTime) - - case(FIELD_DAMAGE_ID) - solres(field) = spectral_damage_solution(timeinc,timeIncOld,remainingLoadCaseTime) + solres(field) = FEM_mech_solution (& + incInfo,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field)) end select - - if (.not. solres(field)%converged) exit ! no solution found - + if(.not. solres(field)%converged) exit ! no solution found enddo stagIter = stagIter + 1_pInt - stagIterate = stagIter < stagItMax & - .and. all(solres(:)%converged) & - .and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration - enddo - -!-------------------------------------------------------------------------------------------------- -! check solution for either advance or retry - - if ( (continueCalculation .or. all(solres(:)%converged .and. solres(:)%stagConverged)) & ! don't care or did converge - .and. .not. solres(1)%termIll) then ! and acceptable solution found - timeIncOld = timeinc - cutBack = .false. - guess = .true. ! start guessing after first converged (sub)inc - if (worldrank == 0) then - write(statUnit,*) totalIncsCounter, time, cutBackLevel, & - solres%converged, solres%iterationsNeeded - flush(statUnit) + stagIterate = stagIter < stagItMax .and. & + all(solres(:)%converged) .and. & + .not. all(solres(:)%stagConverged) + enddo + +! check solution + cutBack = .False. + if(.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found + if (cutBackLevel < maxCutBack) then ! do cut back + if (worldrank == 0) & + write(6,'(/,a)') ' cut back detected' + cutBack = .True. + stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator + cutBackLevel = cutBackLevel + 1_pInt + time = time - timeinc ! rewind time + timeinc = timeinc/2.0_pReal + else ! default behavior, exit if spectral solver does not converge + call IO_warning(850_pInt) + call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written (e.g. for regridding) ! continue from non-converged solution and start guessing after accepted (sub)inc endif - elseif (cutBackLevel < maxCutBack) then ! further cutbacking tolerated? - cutBack = .true. - stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator - cutBackLevel = cutBackLevel + 1_pInt - time = time - timeinc ! rewind time - timeinc = timeinc/real(subStepFactor,pReal) ! cut timestep - write(6,'(/,a)') ' cutting back ' - else ! no more options to continue - call IO_warning(850_pInt) - call MPI_file_close(resUnit,ierr) - close(statUnit) - call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written + else + guess = .true. ! start guessing after first converged (sub)inc + timeIncOld = timeinc endif - - enddo subStepLooping - + if (.not. cutBack) then + if (worldrank == 0) write(statUnit,*) totalIncsCounter, time, cutBackLevel, & + solres%converged, solres%iterationsNeeded ! write statistics about accepted solution + endif + enddo subIncLooping cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc - - if (all(solres(:)%converged)) then + if(all(solres(:)%converged)) then ! report converged inc convergedCounter = convergedCounter + 1_pInt - write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc - ' increment ', totalIncsCounter, ' converged' + if (worldrank == 0) then + write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & + ' increment ', totalIncsCounter, ' converged' + endif else - notConvergedCounter = notConvergedCounter + 1_pInt + if (worldrank == 0) then write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc - ' increment ', totalIncsCounter, ' NOT converged' + ' increment ', totalIncsCounter, ' NOT converged' + endif + notConvergedCounter = notConvergedCounter + 1_pInt endif; flush(6) - if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency + if (worldrank == 0) then write(6,'(1/,a)') ' ... writing results to file ......................................' - flush(6) - call materialpoint_postResults() + endif endif - if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ... - .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information - restartWrite = .true. ! set restart parameter for FEsolving - lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write? - endif - - endif skipping + if( loadCases(currentLoadCase)%restartFrequency > 0_pInt .and. & ! at frequency of writing restart information set restart parameter for FEsolving + mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ToDo first call to CPFEM_general will write? + restartWrite = .true. + lastRestartWritten = inc + endif + else forwarding + time = time + timeinc + guess = .true. + endif forwarding enddo incLooping - enddo loadCaseLooping - !-------------------------------------------------------------------------------------------------- ! report summary of whole calculation + if (worldrank == 0) then write(6,'(/,a)') ' ###########################################################################' - write(6,'(1x,'//IO_intOut(convergedCounter)//',a,'//IO_intOut(notConvergedCounter + convergedCounter)//',a,f5.1,a)') & - convergedCounter, ' out of ', & - notConvergedCounter + convergedCounter, ' (', & - real(convergedCounter, pReal)/& - real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, & - ' %) increments converged!' - flush(6) - call MPI_file_close(resUnit,ierr) - close(statUnit) - + write(6,'(1x,i6.6,a,i6.6,a,f5.1,a)') convergedCounter, ' out of ', & + notConvergedCounter + convergedCounter, ' (', & + real(convergedCounter, pReal)/& + real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, & + ' %) increments converged!' + endif if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged call quit(0_pInt) ! no complains ;) -end program DAMASK_FEM +end program DAMASK_FEM !-------------------------------------------------------------------------------------------------- !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief quit subroutine to mimic behavior of FEM solvers !> @details exits the Spectral solver and reports time and duration. Exit code 0 signals -!> everything went fine. Exit code 1 signals an error, message according to IO_error. Exit code -!> 2 signals no converged solution and increment of last saved restart information is written to +!> everything went fine. Exit code 1 signals an error, message according to IO_error. Exit code +!> 2 signals request for regridding, increment of last saved restart information is written to !> stderr. Exit code 3 signals no severe problems, but some increments did not converge !-------------------------------------------------------------------------------------------------- subroutine quit(stop_id) -#include - use MPI use prec, only: & pInt - + implicit none integer(pInt), intent(in) :: stop_id integer, dimension(8) :: dateAndTime ! type default integer - integer(pInt) :: error = 0_pInt - PetscErrorCode :: ierr = 0 - logical :: ErrorInQuit - - external :: & - PETScFinalize - call PETScFinalize(ierr) - if (ierr /= 0) write(6,'(a)') ' Error in PETScFinalize' -#ifdef _OPENMP - call MPI_finalize(error) - if (error /= 0) write(6,'(a)') ' Error in MPI_finalize' -#endif - ErrorInQuit = (ierr /= 0 .or. error /= 0_pInt) - call date_and_time(values = dateAndTime) write(6,'(/,a)') 'DAMASK terminated on:' write(6,'(a,2(i2.2,a),i4.4)') 'Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& - dateAndTime(1) + dateAndTime(1) write(6,'(a,2(i2.2,a),i2.2)') 'Time: ',dateAndTime(5),':',& dateAndTime(6),':',& - dateAndTime(7) - - if (stop_id == 0_pInt .and. .not. ErrorInQuit) stop 0 ! normal termination - if (stop_id < 0_pInt .and. .not. ErrorInQuit) then ! terminally ill, restart might help + dateAndTime(7) + if (stop_id == 0_pInt) stop 0 ! normal termination + if (stop_id < 0_pInt) then ! trigger regridding write(0,'(a,i6)') 'restart information available at ', stop_id*(-1_pInt) stop 2 endif - if (stop_id == 3_pInt .and. .not. ErrorInQuit) stop 3 ! not all incs converged - + if (stop_id == 3_pInt) stop 3 ! not all incs converged stop 1 ! error (message from IO_error) end subroutine quit diff --git a/src/FEM_mech.f90 b/src/FEM_mech.f90 index bc829b436..50bb68edd 100644 --- a/src/FEM_mech.f90 +++ b/src/FEM_mech.f90 @@ -9,6 +9,8 @@ module FEM_mech use PETScdmda use PETScsnes +use PETScDM +use PETScDMplex use prec, only: & pInt, & pReal @@ -75,9 +77,6 @@ use PETScsnes PetscDSGetDiscretization, & PetscDualSpaceGetFunctional, & DMGetLabelSize, & - DMPlexCopyCoordinates, & - DMPlexGetHeightStratum, & - DMPlexGetDepthStratum, & DMSNESSetFunctionLocal, & DMSNESSetJacobianLocal, & SNESSetOptionsPrefix, & @@ -209,7 +208,7 @@ subroutine FEM_mech_init(fieldBC) endif enddo; enddo call DMPlexCreateSection(mech_mesh,dimPlex,1,pNumComp,pNumDof, & - numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_VEC, & + numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS, & section,ierr) CHKERRQ(ierr) call DMSetDefaultSection(mech_mesh,section,ierr); CHKERRQ(ierr) @@ -607,7 +606,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) !-------------------------------------------------------------------------------------------------- ! apply boundary conditions - call DMPlexCreateRigidBody(dm_local,matnull,ierr); CHKERRQ(ierr) + !call DMPlexCreateRigidBody(dm_local,matnull,ierr); CHKERRQ(ierr) MD: linker error call MatSetNullSpace(Jac,matnull,ierr); CHKERRQ(ierr) call MatSetNearNullSpace(Jac,matnull,ierr); CHKERRQ(ierr) call MatNullSpaceDestroy(matnull,ierr); CHKERRQ(ierr) From 67314fc204f010e955443eb63b524c9c2d680846 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 Aug 2018 16:40:13 +0200 Subject: [PATCH 121/208] leftover from reducing numerics_integrator to scalar postponed simplification to scalar because of heavy modification in plastic constitutive laws --- src/numerics.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/numerics.f90 b/src/numerics.f90 index 05abc0198..146961b86 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -26,7 +26,7 @@ module numerics worldsize = 0_pInt !< MPI worldsize (/=0 for MPI simulations only) integer(4), protected, public :: & DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive -!> ToDo: numerics_integrator in an array for historical reasons, only element 1 is used! + !< ToDo: numerics_integrator is an array for historical reasons, only element 1 is used! integer(pInt), dimension(2), protected, public :: & numerics_integrator = 1_pInt !< method used for state integration (central & perturbed state), Default 1: fix-point iteration for both states real(pReal), protected, public :: & @@ -525,7 +525,7 @@ subroutine numerics_init write(6,'(a24,1x,es8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState write(6,'(a24,1x,es8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress write(6,'(a24,1x,es8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress - write(6,'(a24,1x,es8.1)') ' integtator: ',numerics_integrator + write(6,'(a24,2(1x,i8))') ' integrator: ',numerics_integrator write(6,'(a24,1x,L8)') ' timeSyncing: ',numerics_timeSyncing write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength From 3b3e0bc06851363062efce0d02619f2fa7d0cdf3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 Aug 2018 17:11:50 +0200 Subject: [PATCH 122/208] forgotten use --- src/crystallite.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index cdb112a48..88782751d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -511,8 +511,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) subStepMinCryst, & subStepSizeCryst, & stepIncreaseCryst, & - numerics_integrator, & - numerics_integrationMode, & numerics_timeSyncing use debug, only: & debug_level, & From 4ba5bdd87c1d4d7f34ae2b91da558ab8ad4f18bc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 18:33:26 +0200 Subject: [PATCH 123/208] merged private --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 50eb21714..85ce83964 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 50eb21714e2f501b111bb62096ebb6a5bfc6708a +Subproject commit 85ce83964904324d4e6ce93e14b0b4e1946dc04a From 97659c359a71bcfa49d07611abd4fa5caee4e2a8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 06:41:35 +0200 Subject: [PATCH 124/208] MPI write only in case that PETSc is used --- src/HDF5_utilities.f90 | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index b878543a1..37ddc4ad8 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -2,7 +2,9 @@ module HDF5_Utilities use prec use IO use HDF5 +#ifdef PETSc use PETSC +#endif integer(HID_T), public, protected :: tempCoordinates, tempResults integer(HID_T), private :: resultsFile, currentIncID, plist_id @@ -58,7 +60,9 @@ subroutine HDF5_createJobFile integer :: hdferr integer(SIZE_T) :: typeSize character(len=1024) :: path +#ifdef PETSc #include +#endif !-------------------------------------------------------------------------------------------------- ! initialize HDF5 library and check if integer and float type size match @@ -71,11 +75,13 @@ subroutine HDF5_createJobFile if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5tget_size_f (double)') if (int(pReal,SIZE_T)/=typeSize) call IO_error(0_pInt,ext_msg='pReal does not match H5T_NATIVE_DOUBLE') - ! neu ab hier (4 zeilen) +#ifdef PETSC call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5pcreate_f') call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5pset_fapl_mpio_f') +#endif + !-------------------------------------------------------------------------------------------------- ! open file path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//'hdf5' @@ -321,10 +327,12 @@ subroutine HDF5_mappingPhase(mapping,mapping2,Nconstituents,material_phase,phase !-------------------------------------------------------------------------------------------------- ! Create property list for collective dataset write +#ifdef PETSC call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pset_dxpl_mpio_f') +#endif !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. @@ -439,10 +447,12 @@ subroutine HDF5_backwardMappingPhase(material_phase,phasememberat,phase_name,dat !-------------------------------------------------------------------------------------------------- ! Create property list for collective dataset write +#ifdef PETSC call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pset_dxpl_mpio_f') +#ifdef PETSC !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. @@ -557,10 +567,12 @@ subroutine HDF5_mappingHomog(material_homog,homogmemberat,homogenization_name,da !-------------------------------------------------------------------------------------------------- ! Create property list for collective dataset write +#ifdef PETSC call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pset_dxpl_mpio_f') +#ifdef PETSC !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. @@ -668,10 +680,12 @@ subroutine HDF5_backwardMappingHomog(material_homog,homogmemberat,homogenization !-------------------------------------------------------------------------------------------------- ! Create property list for collective dataset write +#ifdef PETSC call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pset_dxpl_mpio_f') +#ifdef PETSC !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. @@ -799,10 +813,12 @@ subroutine HDF5_mappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name, !-------------------------------------------------------------------------------------------------- ! Create property list for collective dataset write +#ifdef PETSC call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pset_dxpl_mpio_f') +#ifdef PETSC !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. @@ -929,10 +945,12 @@ subroutine HDF5_backwardMappingCrystallite(crystalliteAt,crystmemberAt,crystalli !-------------------------------------------------------------------------------------------------- ! Create property list for collective dataset write +#ifdef PETSC call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pset_dxpl_mpio_f') +#ifdef PETSC !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. @@ -1080,10 +1098,12 @@ subroutine HDF5_writeVectorDataset(group,dataset,label,SIunit,dataspace_size,mpi if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5sselect_hyperslab_f') ! Create property list for collective dataset write +#ifdef PETSC call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5pset_dxpl_mpio_f') +#ifdef PETSC ! Write the dataset collectively call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([vectorSize, dataspace_size],HSIZE_T), hdferr, & @@ -1140,10 +1160,12 @@ subroutine HDF5_writeTensorDataset(group,dataset,label,SIunit,dataspace_size,mpi if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5sselect_hyperslab_f') ! Create property list for collective dataset write +#ifdef PETSC call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5pset_dxpl_mpio_f') +#ifdef PETSC ! Write the dataset collectively call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([tensorSize, dataspace_size],HSIZE_T), hdferr, & @@ -1231,10 +1253,12 @@ subroutine HDF5_writeScalarDataset(group,dataset,label,SIunit,dataspace_size,mpi if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5sselect_hyperslab_f') ! Create property list for collective dataset write +#ifdef PETSC call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5pset_dxpl_mpio_f') +#ifdef PETSC ! Write the dataset collectively call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([dataspace_size],HSIZE_T), hdferr, & From 0bdfae1a4bdce258972c168fa6f5e3f17ce78d9d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 Aug 2018 21:12:55 +0200 Subject: [PATCH 125/208] using newer Intel Compiler --- .gitlab-ci.yml | 15 ++++++++------- PRIVATE | 2 +- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0721f1374..c3aa1c2d1 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -47,6 +47,7 @@ variables: # =============================================================================================== # ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++ IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016" + IntelCompiler16_4: "Compiler/Intel/16.4" IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017" IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018" GNUCompiler7_3: "Compiler/GNU/7.3" @@ -329,7 +330,7 @@ TextureComponents: Marc_compileIfort2017: stage: compileMarc2017 script: - - module load $IntelCompiler17_0 $MSC2017 + - module load $IntelCompiler16_4 $MSC2017 - Marc_compileIfort/test.py -m 2017 except: - master @@ -339,7 +340,7 @@ Marc_compileIfort2017: Hex_elastic: stage: marc script: - - module load $IntelCompiler17_0 $MSC + - module load $IntelCompiler16_4 $MSC - Hex_elastic/test.py except: - master @@ -348,7 +349,7 @@ Hex_elastic: CubicFCC_elastic: stage: marc script: - - module load $IntelCompiler17_0 $MSC + - module load $IntelCompiler16_4 $MSC - CubicFCC_elastic/test.py except: - master @@ -357,7 +358,7 @@ CubicFCC_elastic: CubicBCC_elastic: stage: marc script: - - module load $IntelCompiler17_0 $MSC + - module load $IntelCompiler16_4 $MSC - CubicBCC_elastic/test.py except: - master @@ -366,7 +367,7 @@ CubicBCC_elastic: J2_plasticBehavior: stage: marc script: - - module load $IntelCompiler17_0 $MSC + - module load $IntelCompiler16_4 $MSC - J2_plasticBehavior/test.py except: - master @@ -376,7 +377,7 @@ J2_plasticBehavior: Abaqus_compile2017: stage: compileAbaqus2017 script: - - module load $IntelCompiler16_0 $Abaqus2017 + - module load $IntelCompiler16_4 $Abaqus2017 - Abaqus_compileIfort/test.py -a 2017 except: - master @@ -392,7 +393,7 @@ SpectralExample: AbaqusExample: stage: example script: - - module load $IntelCompiler16_0 $Abaqus + - module load $IntelCompiler16_4 $Abaqus - Abaqus_example/test.py only: - development diff --git a/PRIVATE b/PRIVATE index 85ce83964..737427a96 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 85ce83964904324d4e6ce93e14b0b4e1946dc04a +Subproject commit 737427a967e098e1cc82f69f5447fd1a02ffa855 From 85358bae1becff0d703def4c8c84976bdd179bd8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 Aug 2018 21:30:57 +0200 Subject: [PATCH 126/208] copy and paste error --- src/HDF5_utilities.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 37ddc4ad8..ca75d6aff 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -452,7 +452,7 @@ subroutine HDF5_backwardMappingPhase(material_phase,phasememberat,phase_name,dat if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pset_dxpl_mpio_f') -#ifdef PETSC +#endif !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. @@ -572,7 +572,7 @@ subroutine HDF5_mappingHomog(material_homog,homogmemberat,homogenization_name,da if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pset_dxpl_mpio_f') -#ifdef PETSC +#endif !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. @@ -685,7 +685,7 @@ subroutine HDF5_backwardMappingHomog(material_homog,homogmemberat,homogenization if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pset_dxpl_mpio_f') -#ifdef PETSC +#endif !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. @@ -818,7 +818,7 @@ subroutine HDF5_mappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name, if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pset_dxpl_mpio_f') -#ifdef PETSC +#endif !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. @@ -950,7 +950,7 @@ subroutine HDF5_backwardMappingCrystallite(crystalliteAt,crystmemberAt,crystalli if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pset_dxpl_mpio_f') -#ifdef PETSC +#endif !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. @@ -1103,7 +1103,7 @@ subroutine HDF5_writeVectorDataset(group,dataset,label,SIunit,dataspace_size,mpi if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5pset_dxpl_mpio_f') -#ifdef PETSC +#endif ! Write the dataset collectively call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([vectorSize, dataspace_size],HSIZE_T), hdferr, & @@ -1165,7 +1165,7 @@ subroutine HDF5_writeTensorDataset(group,dataset,label,SIunit,dataspace_size,mpi if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5pset_dxpl_mpio_f') -#ifdef PETSC +#endif ! Write the dataset collectively call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([tensorSize, dataspace_size],HSIZE_T), hdferr, & @@ -1258,7 +1258,7 @@ subroutine HDF5_writeScalarDataset(group,dataset,label,SIunit,dataspace_size,mpi if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5pcreate_f') call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5pset_dxpl_mpio_f') -#ifdef PETSC +#endif ! Write the dataset collectively call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([dataspace_size],HSIZE_T), hdferr, & From 615af684eb7c2a948b6632fb9b80963a867b2800 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 20 Aug 2018 08:55:59 +0200 Subject: [PATCH 127/208] [skip ci] updated version information after successful test of v2.0.2-381-gc03ea8f5 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 943cac93c..fea0a6cd0 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-374-g3e4f6598 +v2.0.2-381-gc03ea8f5 From 8fb780ab42451c553f5e3d1c5adeea69ac4a5a84 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 09:01:13 +0200 Subject: [PATCH 128/208] now compiles with gfortran --- src/FEM_mech.f90 | 3 +- src/FEM_mesh.f90 | 446 ------------------------------------------ src/FEM_utilities.f90 | 1 - src/meshFEM.f90 | 1 - 4 files changed, 1 insertion(+), 450 deletions(-) delete mode 100644 src/FEM_mesh.f90 diff --git a/src/FEM_mech.f90 b/src/FEM_mech.f90 index 50bb68edd..d05e3a184 100644 --- a/src/FEM_mech.f90 +++ b/src/FEM_mech.f90 @@ -63,7 +63,6 @@ use PETScDMplex FEM_mech_destroy external :: & - MPI_Allreduce, & MatZeroRowsColumnsLocalIS, & PetscQuadratureCreate, & PetscFECreateDefault, & @@ -189,7 +188,7 @@ subroutine FEM_mech_init(fieldBC) do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries if (fieldBC%componentBC(field)%Mask(faceSet)) then numBC = numBC + 1 - call ISCreateGeneral(PETSC_COMM_WORLD,1,field-1,PETSC_COPY_VALUES,bcComps(numBC),ierr) + call ISCreateGeneral(PETSC_COMM_WORLD,1,[field-1],PETSC_COPY_VALUES,bcComps(numBC),ierr) CHKERRQ(ierr) call DMGetStratumSize(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcSize,ierr) CHKERRQ(ierr) diff --git a/src/FEM_mesh.f90 b/src/FEM_mesh.f90 deleted file mode 100644 index 82b91ddc9..000000000 --- a/src/FEM_mesh.f90 +++ /dev/null @@ -1,446 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Driver controlling inner and outer load case looping of the FEM solver -!> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing -!> results -!-------------------------------------------------------------------------------------------------- -module mesh - use, intrinsic :: iso_c_binding - use prec, only: pReal, pInt - - implicit none -#include - private - integer(pInt), public, protected :: & - mesh_Nboundaries, & - mesh_NcpElems, & !< total number of CP elements in mesh - mesh_NcpElemsGlobal, & - mesh_Nnodes, & !< total number of nodes in mesh - mesh_maxNnodes, & !< max number of nodes in any CP element - mesh_maxNips, & !< max number of IPs in any CP element - mesh_maxNipNeighbors, & - mesh_Nelems !< total number of elements in mesh - - real(pReal), public, protected :: charLength - - integer(pInt), dimension(:,:), allocatable, public, protected :: & - mesh_element !< FEid, type(internal representation), material, texture, node indices as CP IDs - - real(pReal), dimension(:,:), allocatable, public :: & - mesh_node !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) - - real(pReal), dimension(:,:), allocatable, public, protected :: & - mesh_ipVolume, & !< volume associated with IP (initially!) - mesh_node0 !< node x,y,z coordinates (initially!) - - real(pReal), dimension(:,:,:), allocatable, public :: & - mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) - - real(pReal), dimension(:,:,:), allocatable, public, protected :: & - mesh_ipArea !< area of interface to neighboring IP (initially!) - - real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & - mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) - - integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & - mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] - - logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) - - integer(pInt), dimension(:,:), allocatable, target, private :: & - mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] - mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] - - DM, public :: geomMesh - - integer(pInt), dimension(:), allocatable, public, protected :: & - mesh_boundaries - -! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) -! Hence, I suggest to prefix with "FE_" - - integer(pInt), parameter, public :: & - FE_Nelemtypes = 1_pInt, & - FE_Ngeomtypes = 1_pInt, & - FE_Ncelltypes = 1_pInt, & - FE_maxNnodes = 1_pInt, & - FE_maxNips = 14_pInt - - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type - int([1],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type - int([1],pInt) - - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element - int([0],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), public :: FE_Nips = & !< number of IPs in a specific type of element - int([0],pInt) - - integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type - int([6],pInt) - - - public :: & - mesh_init, & - mesh_FEasCP, & - mesh_FEM_build_ipVolumes, & - mesh_FEM_build_ipCoordinates, & - mesh_cellCenterCoordinates - - external :: & - MPI_abort, & - MPI_Bcast, & - DMClone, & - DMGetDimension, & - DMPlexCreateFromFile, & - DMPlexDistribute, & - DMPlexCopyCoordinates, & - DMGetStratumSize, & - DMPlexGetHeightStratum, & - DMPlexGetLabelValue, & - DMPlexSetLabelValue, & - DMDestroy - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief initializes the mesh by calling all necessary private routines the mesh module -!! Order and routines strongly depend on type of solver -!-------------------------------------------------------------------------------------------------- -subroutine mesh_init(ip,el) - use DAMASK_interface - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) - use IO, only: & - IO_timeStamp, & - IO_error, & - IO_open_file, & - IO_stringPos, & - IO_intValue, & - IO_EOF, & - IO_read, & - IO_isBlank - use debug, only: & - debug_e, & - debug_i - use numerics, only: & - usePingPong, & - integrationOrder, & - worldrank, & - worldsize - use FEsolving, only: & - FEsolving_execElem, & - FEsolving_execIP, & - calcMode - use FEM_Zoo, only: & - FEM_Zoo_nQuadrature, & - FEM_Zoo_QuadraturePoints - - implicit none - integer(pInt), parameter :: FILEUNIT = 222_pInt - integer(pInt), intent(in) :: el, ip - integer(pInt) :: j - integer(pInt), allocatable, dimension(:) :: chunkPos - integer :: dimPlex - character(len=512) :: & - line - logical :: flag - PetscSF :: sf - DM :: globalMesh - PetscInt :: face, nFaceSets - PetscInt, pointer :: pFaceSets(:) - IS :: faceSetIS - PetscErrorCode :: ierr - - - if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- mesh init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - endif - - if (allocated(mesh_mapFEtoCPelem)) deallocate(mesh_mapFEtoCPelem) - if (allocated(mesh_mapFEtoCPnode)) deallocate(mesh_mapFEtoCPnode) - if (allocated(mesh_node0)) deallocate(mesh_node0) - if (allocated(mesh_node)) deallocate(mesh_node) - if (allocated(mesh_element)) deallocate(mesh_element) - if (allocated(mesh_ipCoordinates)) deallocate(mesh_ipCoordinates) - if (allocated(mesh_ipVolume)) deallocate(mesh_ipVolume) - - call DMPlexCreateFromFile(PETSC_COMM_WORLD,geometryFile,PETSC_TRUE,globalMesh,ierr) - CHKERRQ(ierr) - call DMGetDimension(globalMesh,dimPlex,ierr) - CHKERRQ(ierr) - call DMGetStratumSize(globalMesh,'depth',dimPlex,mesh_NcpElemsGlobal,ierr) - CHKERRQ(ierr) - call DMGetLabelSize(globalMesh,'Face Sets',mesh_Nboundaries,ierr) - CHKERRQ(ierr) - call MPI_Bcast(mesh_Nboundaries,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) - call MPI_Bcast(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) - call MPI_Bcast(dimPlex,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) - - allocate(mesh_boundaries(mesh_Nboundaries), source = 0_pInt) - call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr) - CHKERRQ(ierr) - call DMGetLabelIdIS(globalMesh,'Face Sets',faceSetIS,ierr) - CHKERRQ(ierr) - if (nFaceSets > 0) call ISGetIndicesF90(faceSetIS,pFaceSets,ierr) - do face = 1, nFaceSets - mesh_boundaries(face) = pFaceSets(face) - enddo - if (nFaceSets > 0) call ISRestoreIndicesF90(faceSetIS,pFaceSets,ierr) - call MPI_Bcast(mesh_boundaries,mesh_Nboundaries,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) - - if (worldrank == 0) then - j = 0 - flag = .false. - call IO_open_file(FILEUNIT,trim(geometryFile)) - do - read(FILEUNIT,'(a512)') line - if (trim(line) == IO_EOF) exit ! skip empty lines - if (trim(line) == '$Elements') then - read(FILEUNIT,'(a512)') line - read(FILEUNIT,'(a512)') line - flag = .true. - endif - if (trim(line) == '$EndElements') exit - if (flag) then - chunkPos = IO_stringPos(line) - if (chunkPos(1) == 3+IO_intValue(line,chunkPos,3)+dimPlex+1) then - call DMSetLabelValue(globalMesh,'material',j,IO_intValue(line,chunkPos,4),ierr) - CHKERRQ(ierr) - j = j + 1 - endif ! count all identifiers to allocate memory and do sanity check - endif - enddo - close (FILEUNIT) - endif - - if (worldsize > 1) then - call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr) - CHKERRQ(ierr) - else - call DMClone(globalMesh,geomMesh,ierr) - CHKERRQ(ierr) - endif - call DMDestroy(globalMesh,ierr); CHKERRQ(ierr) - - call DMGetStratumSize(geomMesh,'depth',dimPlex,mesh_Nelems,ierr) - CHKERRQ(ierr) - call DMGetStratumSize(geomMesh,'depth',0,mesh_Nnodes,ierr) - CHKERRQ(ierr) - mesh_NcpElems = mesh_Nelems - call mesh_FEM_mapNodesAndElems - - FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder) - mesh_maxNnodes = FE_Nnodes(1_pInt) - mesh_maxNips = FE_Nips(1_pInt) - call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p) - call mesh_FEM_build_ipVolumes(dimPlex) - - allocate (mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems)); mesh_element = 0_pInt - do j = 1, mesh_NcpElems - mesh_element( 1,j) = j - mesh_element( 2,j) = 1_pInt ! elem type - mesh_element( 3,j) = 1_pInt ! homogenization - call DMGetLabelValue(geomMesh,'material',j-1,mesh_element(4,j),ierr) - CHKERRQ(ierr) - end do - - if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & - call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements - if (debug_e < 1 .or. debug_e > mesh_NcpElems) & - call IO_error(602_pInt,ext_msg='element') ! selected element does not exist - if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & - call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP - - FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements - if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP) - allocate(FEsolving_execIP(2_pInt,mesh_NcpElems)); FEsolving_execIP = 1_pInt ! parallel loop bounds set to comprise from first IP... - forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element - - if (allocated(calcMode)) deallocate(calcMode) - allocate(calcMode(mesh_maxNips,mesh_NcpElems)) - calcMode = .false. ! pretend to have collected what first call is asking (F = I) - calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" - -end subroutine mesh_init - -!-------------------------------------------------------------------------------------------------- -!> @brief Gives the FE to CP ID mapping by binary search through lookup array -!! valid questions (what) are 'elem', 'node' -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) - use IO, only: & - IO_lc - - implicit none - character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID - - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center - - mesh_FEasCP = 0_pInt - select case(IO_lc(what(1:4))) - case('elem') - lookupMap => mesh_mapFEtoCPelem - case('node') - lookupMap => mesh_mapFEtoCPnode - case default - return - endselect - - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),pInt) - - if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? - mesh_FEasCP = lookupMap(2_pInt,lower) - return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) - return - endif - - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then - lower = center - elseif (lookupMap(1_pInt,center) > myID) then - upper = center - else - mesh_FEasCP = lookupMap(2_pInt,center) - exit - endif - enddo binarySearch - -end function mesh_FEasCP - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates cell center coordinates. -!-------------------------------------------------------------------------------------------------- -pure function mesh_cellCenterCoordinates(ip,el) - - implicit none - integer(pInt), intent(in) :: el, & !< element number - ip !< integration point number - real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell - - end function mesh_cellCenterCoordinates - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' -!> @details The IP volume is calculated differently depending on the cell type. -!> 2D cells assume an element depth of one in order to calculate the volume. -!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal -!> shape with a cell face as basis and the central ip at the tip. This subvolume is -!> calculated as an average of four tetrahedals with three corners on the cell face -!> and one corner at the central ip. -!-------------------------------------------------------------------------------------------------- -subroutine mesh_FEM_build_ipVolumes(dimPlex) - use math, only: & - math_I3, & - math_det33 - - implicit none - PetscInt :: dimPlex - PetscReal :: vol - PetscReal, target :: cent(dimPlex), norm(dimPlex) - PetscReal, pointer :: pCent(:), pNorm(:) - PetscInt :: cellStart, cellEnd, cell - PetscErrorCode :: ierr - - if (.not. allocated(mesh_ipVolume)) then - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) - mesh_ipVolume = 0.0_pReal - endif - - call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) - pCent => cent - pNorm => norm - do cell = cellStart, cellEnd-1 - call DMPlexComputeCellGeometryFVM(geomMesh,cell,vol,pCent,pNorm,ierr) - CHKERRQ(ierr) - mesh_ipVolume(:,cell+1) = vol/real(mesh_maxNips,pReal) - enddo - -end subroutine mesh_FEM_build_ipVolumes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' -! Called by all solvers in mesh_init in order to initialize the ip coordinates. -! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, -! so no need to use this subroutine anymore; Marc however only provides nodal displacements, -! so in this case the ip coordinates are always calculated on the basis of this subroutine. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, -! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. -! HAS TO BE CHANGED IN A LATER VERSION. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!-------------------------------------------------------------------------------------------------- -subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints) - - implicit none - PetscInt, intent(in) :: dimPlex - PetscReal, intent(in) :: qPoints(mesh_maxNips*dimPlex) - PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), invcellJ(dimPlex*dimPlex) - PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) - PetscReal :: detJ - PetscInt :: cellStart, cellEnd, cell, qPt, dirI, dirJ, qOffset - PetscErrorCode :: ierr - - if (.not. allocated(mesh_ipCoordinates)) then - allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems)) - mesh_ipCoordinates = 0.0_pReal - endif - - pV0 => v0 - pCellJ => cellJ - pInvcellJ => invcellJ - call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) - do cell = cellStart, cellEnd-1 !< loop over all elements - call DMPlexComputeCellGeometryAffineFEM(geomMesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) - CHKERRQ(ierr) - qOffset = 0 - do qPt = 1, mesh_maxNips - do dirI = 1, dimPlex - 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) - enddo - enddo - qOffset = qOffset + dimPlex - enddo - enddo - -end subroutine mesh_FEM_build_ipCoordinates - - -!-------------------------------------------------------------------------------------------------- -!> @brief fake map node from FE ID to internal (consecutive) representation for node and element -!! Allocates global array 'mesh_mapFEtoCPnode' and 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_FEM_mapNodesAndElems - use math, only: & - math_range - - implicit none - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source = 0_pInt) - allocate (mesh_mapFEtoCPelem(2_pInt,mesh_NcpElems), source = 0_pInt) - - mesh_mapFEtoCPnode = spread(math_range(mesh_Nnodes),1,2) - mesh_mapFEtoCPelem = spread(math_range(mesh_NcpElems),1,2) - -end subroutine mesh_FEM_mapNodesAndElems - - -end module mesh diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index 1b1c33b3a..4947fb0c7 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -141,7 +141,6 @@ use PETScis COMPONENT_MGTWIN_PHI_ID external :: & - MPI_Allreduce, & PetscOptionsInsertString, & PetscObjectSetName, & DMPlexGetHeightStratum, & diff --git a/src/meshFEM.f90 b/src/meshFEM.f90 index 7dc5c93af..ee11a37bd 100644 --- a/src/meshFEM.f90 +++ b/src/meshFEM.f90 @@ -97,7 +97,6 @@ use PETScis mesh_cellCenterCoordinates external :: & - MPI_Bcast, & DMPlexCreateFromFile, & DMPlexDistribute, & DMPlexCopyCoordinates, & From 7c683d4f3d49b38a337fcb85c97abd55a57be20b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 09:02:03 +0200 Subject: [PATCH 129/208] updated tests for 38- and 36- branches --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 737427a96..c44717258 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 737427a967e098e1cc82f69f5447fd1a02ffa855 +Subproject commit c4471725893e301044924eb0990e2ad619aa0a46 From f8ce2565c9541731d98b65fae507fad31235c809 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 09:13:20 +0200 Subject: [PATCH 130/208] compilation test for FEM solver active --- .gitlab-ci.yml | 30 ++++++++++++++++++++++++------ 1 file changed, 24 insertions(+), 6 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 114580f8d..caa411bb8 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -3,8 +3,8 @@ stages: - prepareAll - preprocessing - postprocessing - - compileSpectralIntel - - compileSpectralGNU + - compilePETScIntel + - compilePETScGNU - prepareSpectral - spectral - compileMarc2017 @@ -186,8 +186,8 @@ Post_ParaviewRelated: - release ################################################################################################### -Compile_Intel: - stage: compileSpectralIntel +Compile_Spectral_Intel: + stage: compilePETScIntel script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel - SpectralAll_compile/test.py @@ -195,9 +195,18 @@ Compile_Intel: - master - release +Compile_FEM_Intel: + stage: compilePETScIntel + script: + - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel + - FEM_compile/test.py + except: + - master + - release + ################################################################################################### -Compile_GNU: - stage: compileSpectralGNU +Compile_Spectral_GNU: + stage: compilePETScGNU script: - module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU - SpectralAll_compile/test.py @@ -205,6 +214,15 @@ Compile_GNU: - master - release +Compile_FEM_GNU: + stage: compilePETScGNU + script: + - module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU + - FEM_compile/test.py + except: + - master + - release + ################################################################################################### Compile_Intel_Prepare: stage: prepareSpectral From f29a5b3df3dbb1bfef75a26415710d5e56543237 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 13:15:44 +0200 Subject: [PATCH 131/208] not used at all --- src/FEM_zoo.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/FEM_zoo.f90 b/src/FEM_zoo.f90 index c34dfb449..e20efc2a8 100644 --- a/src/FEM_zoo.f90 +++ b/src/FEM_zoo.f90 @@ -41,8 +41,6 @@ subroutine FEM_Zoo_init #endif use IO, only: & IO_timeStamp - use math, only: & - math_binomial implicit none From b8d56ae320c9d66885a36e09100f91d5f92d0082 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 15:59:13 +0200 Subject: [PATCH 132/208] unfified interface for spectral and FEM solver Note: extension to load case and geometry is not added automatically anymore! --- src/DAMASK_spectral.f90 | 6 ++-- src/FEsolving.f90 | 9 +---- src/spectral_interface.f90 | 67 ++++++++++++++------------------------ 3 files changed, 29 insertions(+), 53 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 2ed94d06a..86c2f61e2 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -27,7 +27,7 @@ program DAMASK_spectral loadCaseFile, & geometryFile, & getSolverJobName, & - appendToOutFile + interface_appendToOutFile use IO, only: & IO_read, & IO_isBlank, & @@ -383,7 +383,7 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! write header of output file if (worldrank == 0) then - if (.not. appendToOutFile) then ! after restart, append to existing results file + if (.not. interface_appendToOutFile) then ! after restart, append to existing results file if (getCWD(workingDir)) call IO_error(106_pInt,ext_msg=trim(workingDir)) open(newunit=resUnit,file=trim(getSolverJobName())//& '.spectralOut',form='UNFORMATTED',status='REPLACE') @@ -431,7 +431,7 @@ program DAMASK_spectral call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek') - if (.not. appendToOutFile) then ! if not restarting, write 0th increment + if (.not. interface_appendToOutFile) then ! if not restarting, write 0th increment write(6,'(1/,a)') ' ... writing initial configuration to file ........................' do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1? diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 index 3853cb37f..f31500c26 100644 --- a/src/FEsolving.f90 +++ b/src/FEsolving.f90 @@ -81,20 +81,13 @@ subroutine FE_init modelName = getSolverJobName() #if defined(Spectral) || defined(FEM) - -#ifdef Spectral - restartInc = spectralRestartInc -#endif -#ifdef FEM - restartInc = FEMRestartInc -#endif + restartInc = interface_RestartInc if(restartInc < 0_pInt) then call IO_warning(warning_ID=34_pInt) restartInc = 0_pInt endif restartRead = restartInc > 0_pInt ! only read in if "true" restart requested - #else call IO_open_inputFile(FILEUNIT,modelName) rewind(FILEUNIT) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index c3cb9141b..e859c0f5a 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -1,9 +1,11 @@ !-------------------------------------------------------------------------------------------------- +!> @author Jaeyong Jung, Max-Planck-Institut für Eisenforschung GmbH +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Interfacing between the spectral solver and the material subroutines provided +!> @brief Interfacing between the PETSc-based solvers and the material subroutines provided !! by DAMASK -!> @details Interfacing between the spectral solver and the material subroutines provided +!> @details Interfacing between the PETSc-based solvers and the material subroutines provided !> by DAMASK. Interpretating the command line arguments to get load case, geometry file, !> and working directory. !-------------------------------------------------------------------------------------------------- @@ -13,8 +15,8 @@ module DAMASK_interface implicit none private - logical, public, protected :: appendToOutFile = .false. !< Append to existing spectralOut file (in case of restart, not in case of regridding) - integer(pInt), public, protected :: spectralRestartInc = 0_pInt !< Increment at which calculation starts + logical, public, protected :: interface_appendToOutFile = .false. !< Append to existing spectralOut file (in case of restart, not in case of regridding) + integer(pInt), public, protected :: interface_restartInc = 0_pInt !< Increment at which calculation starts character(len=1024), public, protected :: & geometryFile = '', & !< parameter given for geometry file loadCaseFile = '' !< parameter given for load case file @@ -54,11 +56,11 @@ subroutine DAMASK_interface_init() implicit none character(len=1024) :: & commandLine, & !< command line call as string - loadcaseArg = '', & !< -l argument given to DAMASK_spectral.exe - geometryArg = '', & !< -g argument given to DAMASK_spectral.exe - workingDirArg = '', & !< -w argument given to DAMASK_spectral.exe - hostName, & !< name of machine on which DAMASK_spectral.exe is execute (might require export HOSTNAME) - userName, & !< name of user calling DAMASK_spectral.exe + loadcaseArg = '', & !< -l argument given to the executable + geometryArg = '', & !< -g argument given to the executable + workingDirArg = '', & !< -w argument given to the executable + hostName, & !< name of machine (might require export HOSTNAME) + userName, & !< name of user calling the executable tag integer :: & i, & @@ -110,7 +112,7 @@ subroutine DAMASK_interface_init() endif mainProcess call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>' + write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& @@ -120,7 +122,6 @@ subroutine DAMASK_interface_init() dateAndTime(6),':',& dateAndTime(7) write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize - write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' #include "compilation_info.f90" call get_command(commandLine) @@ -129,9 +130,8 @@ subroutine DAMASK_interface_init() select case(IIO_stringValue(commandLine,chunkPos,i)) ! extract key case ('-h','--help') write(6,'(a)') ' #######################################################################' - write(6,'(a)') ' DAMASK_spectral:' - write(6,'(a)') ' The spectral method boundary value problem solver for' - write(6,'(a)') ' the Düsseldorf Advanced Material Simulation Kit' + write(6,'(a)') ' DAMASK Command Line Interface:' + write(6,'(a)') ' For PETSc-based solvers for the Düsseldorf Advanced Material Simulation Kit' write(6,'(a,/)')' #######################################################################' write(6,'(a,/)')' Valid command line switches:' write(6,'(a)') ' --geom (-g, --geometry)' @@ -141,23 +141,14 @@ subroutine DAMASK_interface_init() write(6,'(a)') ' --help (-h)' write(6,'(/,a)')' -----------------------------------------------------------------------' write(6,'(a)') ' Mandatory arguments:' - write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom.geom' - write(6,'(a)') ' Specifies the location of the geometry definition file,' - write(6,'(a)') ' if no extension is given, .geom will be appended.' - write(6,'(a)') ' "PathToGeomFile" will be the working directory if not specified' - write(6,'(a)') ' via --workingdir.' - write(6,'(a)') ' Make sure the file "material.config" exists in the working' - write(6,'(a)') ' directory.' - write(6,'(a)') ' For further configuration place "numerics.config"' - write(6,'(a)')' and "numerics.config" in that directory.' - write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile.load' - write(6,'(a)') ' Specifies the location of the load case definition file,' - write(6,'(a)') ' if no extension is given, .load will be appended.' + write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom' + write(6,'(a)') ' Specifies the location of the geometry definition file.' + write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile' + write(6,'(a)') ' Specifies the location of the load case definition file.' write(6,'(/,a)')' -----------------------------------------------------------------------' write(6,'(a)') ' Optional arguments:' write(6,'(/,a)')' --workingdirectory PathToWorkingDirectory' - write(6,'(a)') ' Specifies the working directory and overwrites the default' - write(6,'(a)') ' "PathToGeomFile".' + write(6,'(a)') ' Specifies the working directory and overwrites the default ./' write(6,'(a)') ' Make sure the file "material.config" exists in the working' write(6,'(a)') ' directory.' write(6,'(a)') ' For further configuration place "numerics.config"' @@ -166,7 +157,7 @@ subroutine DAMASK_interface_init() write(6,'(a)') ' Reads in increment XX and continues with calculating' write(6,'(a)') ' increment XX+1 based on this.' write(6,'(a)') ' Appends to existing results file' - write(6,'(a)') ' "NameOfGeom_NameOfLoadFile.spectralOut".' + write(6,'(a)') ' "NameOfGeom_NameOfLoadFile".' write(6,'(a)') ' Works only if the restart information for increment XX' write(6,'(a)') ' is available in the working directory.' write(6,'(/,a)')' -----------------------------------------------------------------------' @@ -182,8 +173,8 @@ subroutine DAMASK_interface_init() if (i < chunkPos(1)) workingDirArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) case ('-r', '--rs', '--restart') if (i < chunkPos(1)) then - spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) - appendToOutFile = .true. + interface_restartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) + interface_appendToOutFile = .true. endif end select enddo @@ -210,9 +201,9 @@ subroutine DAMASK_interface_init() write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) - if (SpectralRestartInc > 0_pInt) & - write(6,'(a,i6.6)') ' Restart from increment: ', spectralRestartInc - write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile + if (interface_restartInc > 0_pInt) & + write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc + write(6,'(a,l1,/)') ' Append to result file: ', interface_appendToOutFile end subroutine DAMASK_interface_init @@ -288,14 +279,10 @@ character(len=1024) function getGeometryFile(geometryParameter) implicit none character(len=1024), intent(in) :: & geometryParameter - integer :: posExt, posSep external :: quit getGeometryFile = trim(geometryParameter) - posExt = scan(getGeometryFile,'.',back=.true.) - posSep = scan(getGeometryFile,'/',back=.true.) - if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') if (scan(getGeometryFile,'/') /= 1) & getGeometryFile = trim(workingDirectory)//'/'//trim(getGeometryFile) @@ -313,14 +300,10 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) implicit none character(len=1024), intent(in) :: & loadCaseParameter - integer :: posExt, posSep external :: quit getLoadCaseFile = trim(loadCaseParameter) - posExt = scan(getLoadCaseFile,'.',back=.true.) - posSep = scan(getLoadCaseFile,'/',back=.true.) - if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') if (scan(getLoadCaseFile,'/') /= 1) & getLoadCaseFile = trim(workingDirectory)//'/'//trim(getLoadCaseFile) From 3e4c878304cd3ac35b060130829b81a9185fc779 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 16:09:40 +0200 Subject: [PATCH 133/208] using shared interface for spectral and FEM solver group_scalar seems inappropriate as integers are also scalars. renamed to group_float (is actually usually of double precision). think about better name, types should have a t prefix. tgroupFloat? --- PRIVATE | 2 +- src/CMakeLists.txt | 8 +- src/DAMASK_FEM.f90 | 3 +- ...ral_interface.f90 => DAMASK_interface.f90} | 0 src/FEM_interface.f90 | 470 ------------------ src/FEM_zoo.f90 | 4 +- src/material.f90 | 4 +- src/prec.f90 | 4 +- src/vacancyflux_cahnhilliard.f90 | 4 +- 9 files changed, 11 insertions(+), 488 deletions(-) rename src/{spectral_interface.f90 => DAMASK_interface.f90} (100%) delete mode 100644 src/FEM_interface.f90 diff --git a/PRIVATE b/PRIVATE index c44717258..50eb21714 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c4471725893e301044924eb0990e2ad619aa0a46 +Subproject commit 50eb21714e2f501b111bb62096ebb6a5bfc6708a diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 43381532b..f86aa9eee 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -17,13 +17,7 @@ list(APPEND OBJECTFILES $) add_library(PREC OBJECT "prec.f90") list(APPEND OBJECTFILES $) -if (PROJECT_NAME STREQUAL "DAMASK_spectral") - add_library(DAMASK_INTERFACE OBJECT "spectral_interface.f90") -elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") - add_library(DAMASK_INTERFACE OBJECT "FEM_interface.f90") -else () - message (FATAL_ERROR "Build target (PROJECT_NAME) is not defined") -endif() +add_library(DAMASK_INTERFACE OBJECT "DAMASK_interface.f90") add_dependencies(DAMASK_INTERFACE PREC SYSTEM_ROUTINES) list(APPEND OBJECTFILES $) diff --git a/src/DAMASK_FEM.f90 b/src/DAMASK_FEM.f90 index b0f6e5d97..ee425585c 100644 --- a/src/DAMASK_FEM.f90 +++ b/src/DAMASK_FEM.f90 @@ -16,8 +16,7 @@ program DAMASK_FEM use DAMASK_interface, only: & DAMASK_interface_init, & loadCaseFile, & - getSolverJobName, & - appendToOutFile + getSolverJobName use IO, only: & IO_read, & IO_isBlank, & diff --git a/src/spectral_interface.f90 b/src/DAMASK_interface.f90 similarity index 100% rename from src/spectral_interface.f90 rename to src/DAMASK_interface.f90 diff --git a/src/FEM_interface.f90 b/src/FEM_interface.f90 deleted file mode 100644 index 0363ffdaa..000000000 --- a/src/FEM_interface.f90 +++ /dev/null @@ -1,470 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Interfacing between the FEM solvers and the material subroutines provided -!! by DAMASK -!> @details Interfacing between the FEM solvers and the material subroutines provided -!> by DAMASK. Interpretating the command line arguments to the init routine to -!> get load case, geometry file, working directory, etc. -!-------------------------------------------------------------------------------------------------- -module DAMASK_interface - use prec, only: & - pInt - - implicit none - private - logical, public, protected :: appendToOutFile = .false. !< Append to existing output file - integer(pInt), public, protected :: FEMRestartInc = 0_pInt !< Increment at which calculation starts - character(len=1024), public, protected :: & - geometryFile = '', & !< parameter given for geometry file - loadCaseFile = '' !< parameter given for load case file - character(len=1024), private :: workingDirectory - - public :: & - getSolverJobName, & - DAMASK_interface_init - private :: & - setWorkingDirectory, & - getGeometryFile, & - getLoadCaseFile, & - rectifyPath, & - makeRelativePath, & - IIO_stringValue, & - IIO_intValue, & - IIO_stringPos -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief initializes the solver by interpreting the command line arguments. Also writes -!! information on computation to screen -!-------------------------------------------------------------------------------------------------- -subroutine DAMASK_interface_init() - use, intrinsic :: & - iso_fortran_env -#include -#if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINOR!=9 -=================================================================================================== -========================= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ========================= -=================================================================================================== -#endif - use PETScSys - use system_routines, only: & - getHostName - - implicit none - character(len=1024) :: & - commandLine, & !< command line call as string - loadcaseArg = '', & !< -l argument given to DAMASK_FEM.exe - geometryArg = '', & !< -g argument given to DAMASK_FEM.exe - workingDirArg = '', & !< -w argument given to DAMASK_FEM.exe - hostName, & !< name of machine on which DAMASK_FEM.exe is execute (might require export HOSTNAME) - userName, & !< name of user calling DAMASK_FEM.exe - tag - integer :: & - i, & -#ifdef _OPENMP - threadLevel, & -#endif - worldrank = 0, & - worldsize = 0 - integer, allocatable, dimension(:) :: & - chunkPos - integer, dimension(8) :: & - dateAndTime ! type default integer - PetscErrorCode :: ierr - logical :: error - external :: & - quit,& - PETScErrorF, & ! is called in the CHKERRQ macro - PETScInitialize - - open(6, encoding='UTF-8') ! for special characters in output - -!-------------------------------------------------------------------------------------------------- -! PETSc Init -#ifdef _OPENMP - ! If openMP is enabled, check if the MPI libary supports it and initialize accordingly. - ! Otherwise, the first call to PETSc will do the initialization. - call MPI_Init_Thread(MPI_THREAD_FUNNELED,threadLevel,ierr);CHKERRQ(ierr) - if (threadLevel>>' - write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018' - write(6,'(/,a)') ' Version: '//DAMASKVERSION - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize - write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' -#include "compilation_info.f90" - - call get_command(commandLine) - chunkPos = IIO_stringPos(commandLine) - do i = 2_pInt, chunkPos(1) - select case(IIO_stringValue(commandLine,chunkPos,i)) ! extract key - case ('-h','--help') - write(6,'(a)') ' #######################################################################' - write(6,'(a)') ' DAMASK_FEM:' - write(6,'(a)') ' FEM solvers for the Düsseldorf Advanced Material Simulation Kit' - write(6,'(a,/)')' #######################################################################' - write(6,'(a,/)')' Valid command line switches:' - write(6,'(a)') ' --geom (-g, --geometry)' - write(6,'(a)') ' --load (-l, --loadcase)' - write(6,'(a)') ' --workingdir (-w, --wd, --workingdirectory, -d, --directory)' - write(6,'(a)') ' --restart (-r, --rs)' - write(6,'(a)') ' --help (-h)' - write(6,'(/,a)')' -----------------------------------------------------------------------' - write(6,'(a)') ' Mandatory arguments:' - write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom.geom' - write(6,'(a)') ' Specifies the location of the geometry definition file,' - write(6,'(a)') ' if no extension is given, .geom will be appended.' - write(6,'(a)') ' "PathToGeomFile" will be the working directory if not specified' - write(6,'(a)') ' via --workingdir.' - write(6,'(a)') ' Make sure the file "material.config" exists in the working' - write(6,'(a)') ' directory.' - write(6,'(a)') ' For further configuration place "numerics.config"' - write(6,'(a)')' and "numerics.config" in that directory.' - write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile.load' - write(6,'(a)') ' Specifies the location of the load case definition file,' - write(6,'(a)') ' if no extension is given, .load will be appended.' - write(6,'(/,a)')' -----------------------------------------------------------------------' - write(6,'(a)') ' Optional arguments:' - write(6,'(/,a)')' --workingdirectory PathToWorkingDirectory' - write(6,'(a)') ' Specifies the working directory and overwrites the default' - write(6,'(a)') ' "PathToGeomFile".' - write(6,'(a)') ' Make sure the file "material.config" exists in the working' - write(6,'(a)') ' directory.' - write(6,'(a)') ' For further configuration place "numerics.config"' - write(6,'(a)')' and "debug.config" in that directory.' - write(6,'(/,a)')' --restart XX' - write(6,'(a)') ' Reads in increment XX and continues with calculating' - write(6,'(a)') ' increment XX+1 based on this.' - write(6,'(a)') ' Appends to existing results file' - write(6,'(a)') ' "NameOfGeom_NameOfLoadFile.YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY".' - write(6,'(a)') ' Works only if the restart information for increment XX' - write(6,'(a)') ' is available in the working directory.' - write(6,'(/,a)')' -----------------------------------------------------------------------' - write(6,'(a)') ' Help:' - write(6,'(/,a)')' --help' - write(6,'(a,/)')' Prints this message and exits' - call quit(0_pInt) ! normal Termination - case ('-l', '--load', '--loadcase') - if ( i < chunkPos(1)) loadcaseArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) - case ('-g', '--geom', '--geometry') - if (i < chunkPos(1)) geometryArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) - case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory') - if (i < chunkPos(1)) workingDirArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) - case ('-r', '--rs', '--restart') - if (i < chunkPos(1)) then - FEMRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) - appendToOutFile = .true. - endif - end select - enddo - - if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0) then - write(6,'(a)') ' Please specify geometry AND load case (-h for help)' - call quit(1_pInt) - endif - - workingDirectory = trim(setWorkingDirectory(trim(workingDirArg))) - geometryFile = getGeometryFile(geometryArg) - loadCaseFile = getLoadCaseFile(loadCaseArg) - - call get_environment_variable('USER',userName) - error = getHostName(hostName) - write(6,'(a,a)') ' Host name: ', trim(hostName) - write(6,'(a,a)') ' User name: ', trim(userName) - write(6,'(a,a)') ' Command line call: ', trim(commandLine) - if (len(trim(workingDirArg)) > 0) & - write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) - write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) - write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg) - write(6,'(a,a)') ' Working directory: ', trim(workingDirectory) - write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) - write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) - write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) - if (FEMRestartInc > 0_pInt) & - write(6,'(a,i6.6)') ' Restart from increment: ', FEMRestartInc - write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile - -end subroutine DAMASK_interface_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief extract working directory from given argument or from location of geometry file, -!! possibly converting relative arguments to absolut path -!-------------------------------------------------------------------------------------------------- -character(len=1024) function setWorkingDirectory(workingDirectoryArg) - use system_routines, only: & - getCWD, & - setCWD - - implicit none - character(len=*), intent(in) :: workingDirectoryArg !< working directory argument - logical :: error - external :: quit - - wdGiven: if (len(workingDirectoryArg)>0) then - absolutePath: if (workingDirectoryArg(1:1) == '/') then - setWorkingDirectory = workingDirectoryArg - else absolutePath - error = getCWD(setWorkingDirectory) - if (error) call quit(1_pInt) - setWorkingDirectory = trim(setWorkingDirectory)//'/'//workingDirectoryArg - endif absolutePath - else wdGiven - error = getCWD(setWorkingDirectory) ! relative path given as command line argument - if (error) call quit(1_pInt) - endif wdGiven - - setWorkingDirectory = trim(rectifyPath(setWorkingDirectory)) - - error = setCWD(trim(setWorkingDirectory)) - if(error) then - write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist' - call quit(1_pInt) - endif - -end function setWorkingDirectory - - -!-------------------------------------------------------------------------------------------------- -!> @brief solver job name (no extension) as combination of geometry and load case name -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getSolverJobName() - - implicit none - integer :: posExt,posSep - character(len=1024) :: tempString - - - tempString = geometryFile - posExt = scan(tempString,'.',back=.true.) - posSep = scan(tempString,'/',back=.true.) - - getSolverJobName = tempString(posSep+1:posExt-1) - - tempString = loadCaseFile - posExt = scan(tempString,'.',back=.true.) - posSep = scan(tempString,'/',back=.true.) - - getSolverJobName = trim(getSolverJobName)//'_'//tempString(posSep+1:posExt-1) - -end function getSolverJobName - - -!-------------------------------------------------------------------------------------------------- -!> @brief basename of geometry file with extension from command line arguments -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getGeometryFile(geometryParameter) - - implicit none - character(len=1024), intent(in) :: & - geometryParameter - integer :: posExt, posSep - external :: quit - - getGeometryFile = trim(geometryParameter) - posExt = scan(getGeometryFile,'.',back=.true.) - posSep = scan(getGeometryFile,'/',back=.true.) - - if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') - if (scan(getGeometryFile,'/') /= 1) & - getGeometryFile = trim(workingDirectory)//'/'//trim(getGeometryFile) - - getGeometryFile = makeRelativePath(workingDirectory, getGeometryFile) - - -end function getGeometryFile - - -!-------------------------------------------------------------------------------------------------- -!> @brief relative path of loadcase from command line arguments -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getLoadCaseFile(loadCaseParameter) - - implicit none - character(len=1024), intent(in) :: & - loadCaseParameter - integer :: posExt, posSep - external :: quit - - getLoadCaseFile = trim(loadCaseParameter) - posExt = scan(getLoadCaseFile,'.',back=.true.) - posSep = scan(getLoadCaseFile,'/',back=.true.) - - if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') - if (scan(getLoadCaseFile,'/') /= 1) & - getLoadCaseFile = trim(workingDirectory)//'/'//trim(getLoadCaseFile) - - getLoadCaseFile = makeRelativePath(workingDirectory, getLoadCaseFile) - -end function getLoadCaseFile - - -!-------------------------------------------------------------------------------------------------- -!> @brief remove ../, /./, and // from path. -!> @details works only if absolute path is given -!-------------------------------------------------------------------------------------------------- -function rectifyPath(path) - - implicit none - character(len=*) :: path - character(len=len_trim(path)) :: rectifyPath - integer :: i,j,k,l ! no pInt - -!-------------------------------------------------------------------------------------------------- -! remove /./ from path - l = len_trim(path) - rectifyPath = path - do i = l,3,-1 - if (rectifyPath(i-2:i) == '/./') rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' - enddo - -!-------------------------------------------------------------------------------------------------- -! remove // from path - l = len_trim(path) - rectifyPath = path - do i = l,2,-1 - if (rectifyPath(i-1:i) == '//') rectifyPath(i-1:l) = rectifyPath(i:l)//' ' - enddo - -!-------------------------------------------------------------------------------------------------- -! remove ../ and corresponding directory from rectifyPath - l = len_trim(rectifyPath) - i = index(rectifyPath(i:l),'../') - j = 0 - do while (i > j) - j = scan(rectifyPath(1:i-2),'/',back=.true.) - rectifyPath(j+1:l) = rectifyPath(i+3:l)//repeat(' ',2+i-j) - if (rectifyPath(j+1:j+1) == '/') then !search for '//' that appear in case of XXX/../../XXX - k = len_trim(rectifyPath) - rectifyPath(j+1:k-1) = rectifyPath(j+2:k) - rectifyPath(k:k) = ' ' - endif - i = j+index(rectifyPath(j+1:l),'../') - enddo - if(len_trim(rectifyPath) == 0) rectifyPath = '/' - -end function rectifyPath - - -!-------------------------------------------------------------------------------------------------- -!> @brief relative path from absolute a to absolute b -!-------------------------------------------------------------------------------------------------- -character(len=1024) function makeRelativePath(a,b) - - implicit none - character (len=*), intent(in) :: a,b - character (len=1024) :: a_cleaned,b_cleaned - integer :: i,posLastCommonSlash,remainingSlashes !no pInt - - posLastCommonSlash = 0 - remainingSlashes = 0 - a_cleaned = rectifyPath(trim(a)//'/') - b_cleaned = rectifyPath(b) - - do i = 1, min(1024,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 - do i = posLastCommonSlash+1,len_trim(a_cleaned) - if (a_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1 - enddo - - makeRelativePath = repeat('..'//'/',remainingSlashes)//b_cleaned(posLastCommonSlash+1:len_trim(b_cleaned)) - -end function makeRelativePath - - -!-------------------------------------------------------------------------------------------------- -!> @brief taken from IO, check IO_stringValue for documentation -!-------------------------------------------------------------------------------------------------- -pure function IIO_stringValue(string,chunkPos,myChunk) - - implicit none - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - character(len=chunkPos(myChunk*2+1)-chunkPos(myChunk*2)+1) :: IIO_stringValue - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - - IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) - -end function IIO_stringValue - - -!-------------------------------------------------------------------------------------------------- -!> @brief taken from IO, check IO_intValue for documentation -!-------------------------------------------------------------------------------------------------- -integer(pInt) pure function IIO_intValue(string,chunkPos,myChunk) - - implicit none - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired sub string - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - - - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then - IIO_intValue = 0_pInt - else valuePresent - read(UNIT=string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)),ERR=100,FMT=*) IIO_intValue - endif valuePresent - return -100 IIO_intValue = huge(1_pInt) - -end function IIO_intValue - - -!-------------------------------------------------------------------------------------------------- -!> @brief taken from IO, check IO_stringPos for documentation -!-------------------------------------------------------------------------------------------------- -pure function IIO_stringPos(string) - - implicit none - integer(pInt), dimension(:), allocatable :: IIO_stringPos - character(len=*), intent(in) :: string !< string in which chunks are searched for - - character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces - integer :: left, right ! no pInt (verify and scan return default integer) - - allocate(IIO_stringPos(1), source=0_pInt) - right = 0 - - do while (verify(string(right+1:),SEP)>0) - left = right + verify(string(right+1:),SEP) - right = left + scan(string(left:),SEP) - 2 - if ( string(left:left) == '#' ) exit - IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)] - IIO_stringPos(1) = IIO_stringPos(1)+1_pInt - enddo - -end function IIO_stringPos - -end module diff --git a/src/FEM_zoo.f90 b/src/FEM_zoo.f90 index e20efc2a8..67c518c47 100644 --- a/src/FEM_zoo.f90 +++ b/src/FEM_zoo.f90 @@ -3,7 +3,7 @@ !> @brief Interpolation data used by the FEM solver !-------------------------------------------------------------------------------------------------- module FEM_Zoo - use prec, only: pReal, pInt, p_vec + use prec, only: pReal, pInt, group_float implicit none private @@ -20,7 +20,7 @@ module FEM_Zoo -1.0_pReal, -1.0_pReal, 1.0_pReal], shape=[3,4]) integer(pInt), dimension(3,maxOrder), public, protected :: & FEM_Zoo_nQuadrature !< number of quadrature points for a given spatial dimension(1-3) and interpolation order(1-maxOrder) - type(p_vec), dimension(3,maxOrder), public, protected :: & + type(group_float), dimension(3,maxOrder), public, protected :: & FEM_Zoo_QuadratureWeights, & !< quadrature weights for each quadrature rule FEM_Zoo_QuadraturePoints !< quadrature point coordinates (in simplical system) for each quadrature rule diff --git a/src/material.f90 b/src/material.f90 index c2c52aaa6..bc267bd60 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -16,7 +16,7 @@ module material tSourceState, & tHomogMapping, & tPhaseMapping, & - group_scalar, & + group_float, & group_int implicit none @@ -268,7 +268,7 @@ module material porosityMapping, & !< mapping for porosity state/fields hydrogenfluxMapping !< mapping for hydrogen conc state/fields - type(group_scalar), allocatable, dimension(:), public :: & + type(group_float), allocatable, dimension(:), public :: & temperature, & !< temperature field damage, & !< damage field vacancyConc, & !< vacancy conc field diff --git a/src/prec.f90 b/src/prec.f90 index caf59cfe8..cfbc71fec 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -28,9 +28,9 @@ module prec integer(pInt), allocatable, dimension(:) :: realloc_lhs_test - type, public :: group_scalar !< variable length datatype used for storage of state + type, public :: group_float !< variable length datatype used for storage of state real(pReal), dimension(:), pointer :: p - end type group_scalar + end type group_float type, public :: group_int integer(pInt), dimension(:), pointer :: p diff --git a/src/vacancyflux_cahnhilliard.f90 b/src/vacancyflux_cahnhilliard.f90 index 96fd50d64..ae5bd1cbc 100644 --- a/src/vacancyflux_cahnhilliard.f90 +++ b/src/vacancyflux_cahnhilliard.f90 @@ -7,7 +7,7 @@ module vacancyflux_cahnhilliard use prec, only: & pReal, & pInt, & - group_scalar + group_float implicit none private @@ -26,7 +26,7 @@ module vacancyflux_cahnhilliard real(pReal), dimension(:), allocatable, private :: & vacancyflux_cahnhilliard_flucAmplitude - type(group_scalar), dimension(:), allocatable, private :: & + type(group_float), dimension(:), allocatable, private :: & vacancyflux_cahnhilliard_thermalFluc real(pReal), parameter, private :: & From e3e905938e4770e16969af436752df88618a184b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 16:23:05 +0200 Subject: [PATCH 134/208] all elements are CP elements --- src/meshFEM.f90 | 85 ++----------------------------------------------- 1 file changed, 3 insertions(+), 82 deletions(-) diff --git a/src/meshFEM.f90 b/src/meshFEM.f90 index ee11a37bd..141b1b0a9 100644 --- a/src/meshFEM.f90 +++ b/src/meshFEM.f90 @@ -54,17 +54,11 @@ use PETScis logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) - integer(pInt), dimension(:,:), allocatable, target, private :: & - mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] - mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] - DM, public :: geomMesh integer(pInt), dimension(:), allocatable, public, protected :: & mesh_boundaries -! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) -! Hence, I suggest to prefix with "FE_" integer(pInt), parameter, public :: & FE_Nelemtypes = 1_pInt, & @@ -91,7 +85,6 @@ use PETScis public :: & mesh_init, & - mesh_FEasCP, & mesh_FEM_build_ipVolumes, & mesh_FEM_build_ipCoordinates, & mesh_cellCenterCoordinates @@ -161,8 +154,6 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - if (allocated(mesh_mapFEtoCPelem)) deallocate(mesh_mapFEtoCPelem) - if (allocated(mesh_mapFEtoCPnode)) deallocate(mesh_mapFEtoCPnode) if (allocated(mesh_node0)) deallocate(mesh_node0) if (allocated(mesh_node)) deallocate(mesh_node) if (allocated(mesh_element)) deallocate(mesh_element) @@ -232,7 +223,6 @@ subroutine mesh_init(ip,el) call DMGetStratumSize(geomMesh,'depth',0,mesh_Nnodes,ierr) CHKERRQ(ierr) mesh_NcpElems = mesh_Nelems - call mesh_FEM_mapNodesAndElems FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder) mesh_maxNnodes = FE_Nnodes(1_pInt) @@ -243,8 +233,8 @@ subroutine mesh_init(ip,el) allocate (mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems)); mesh_element = 0_pInt do j = 1, mesh_NcpElems mesh_element( 1,j) = j - mesh_element( 2,j) = 1_pInt ! elem type - mesh_element( 3,j) = 1_pInt ! homogenization + mesh_element( 2,j) = 1_pInt ! elem type + mesh_element( 3,j) = 1_pInt ! homogenization call DMGetLabelValue(geomMesh,'material',j-1,mesh_element(4,j),ierr) CHKERRQ(ierr) end do @@ -264,60 +254,10 @@ subroutine mesh_init(ip,el) if (allocated(calcMode)) deallocate(calcMode) allocate(calcMode(mesh_maxNips,mesh_NcpElems)) calcMode = .false. ! pretend to have collected what first call is asking (F = I) - calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" + calcMode(ip,el) = .true. ! first ip,el needs to be already pingponged to "calc" end subroutine mesh_init -!-------------------------------------------------------------------------------------------------- -!> @brief Gives the FE to CP ID mapping by binary search through lookup array -!! valid questions (what) are 'elem', 'node' -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) - use IO, only: & - IO_lc - - implicit none - character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID - - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center - - mesh_FEasCP = 0_pInt - select case(IO_lc(what(1:4))) - case('elem') - lookupMap => mesh_mapFEtoCPelem - case('node') - lookupMap => mesh_mapFEtoCPnode - case default - return - endselect - - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),pInt) - - if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? - mesh_FEasCP = lookupMap(2_pInt,lower) - return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) - return - endif - - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then - lower = center - elseif (lookupMap(1_pInt,center) > myID) then - upper = center - else - mesh_FEasCP = lookupMap(2_pInt,center) - exit - endif - enddo binarySearch - -end function mesh_FEasCP - !-------------------------------------------------------------------------------------------------- !> @brief Calculates cell center coordinates. @@ -421,23 +361,4 @@ subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints) end subroutine mesh_FEM_build_ipCoordinates - -!-------------------------------------------------------------------------------------------------- -!> @brief fake map node from FE ID to internal (consecutive) representation for node and element -!! Allocates global array 'mesh_mapFEtoCPnode' and 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_FEM_mapNodesAndElems - use math, only: & - math_range - - implicit none - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source = 0_pInt) - allocate (mesh_mapFEtoCPelem(2_pInt,mesh_NcpElems), source = 0_pInt) - - mesh_mapFEtoCPnode = spread(math_range(mesh_Nnodes),1,2) - mesh_mapFEtoCPelem = spread(math_range(mesh_NcpElems),1,2) - -end subroutine mesh_FEM_mapNodesAndElems - - end module mesh From 93562d5142532cf5c410cad183a6ff2447866fb7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 16:42:47 +0200 Subject: [PATCH 135/208] mapping of elements etc not needed for PETSc-based FEM and spectral solvers --- src/mesh.f90 | 33 ++++++++++----------------------- src/meshFEM.f90 | 14 +++----------- 2 files changed, 13 insertions(+), 34 deletions(-) diff --git a/src/mesh.f90 b/src/mesh.f90 index 5606b656b..4e72ba73e 100644 --- a/src/mesh.f90 +++ b/src/mesh.f90 @@ -95,9 +95,11 @@ module mesh integer(pInt), dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID +#if defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), dimension(:,:), allocatable, target, private :: & mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] +#endif integer(pInt),dimension(:,:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell @@ -402,7 +404,9 @@ module mesh public :: & mesh_init, & +#if defined(Marc4DAMASK) || defined(Abaqus) mesh_FEasCP, & +#endif mesh_build_cellnodes, & mesh_build_ipVolumes, & mesh_build_ipCoordinates, & @@ -420,7 +424,6 @@ module mesh #ifdef Spectral mesh_spectral_getHomogenization, & mesh_spectral_count, & - mesh_spectral_mapNodesAndElems, & mesh_spectral_count_cpSizes, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & @@ -552,8 +555,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) call mesh_spectral_count() if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_spectral_mapNodesAndElems - if (myDebug) write(6,'(a)') ' Mapped nodes and elements'; flush(6) call mesh_spectral_count_cpSizes if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) call mesh_spectral_build_nodes() @@ -659,12 +660,16 @@ subroutine mesh_init(ip,el) allocate(calcMode(mesh_maxNips,mesh_NcpElems)) calcMode = .false. ! pretend to have collected what first call is asking (F = I) +#if defined(Marc4DAMASK) || defined(Abaqus) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" - +#else + calcMode(ip,el) = .true. ! first ip,el needs to be already pingponged to "calc" +#endif end subroutine mesh_init +#if defined(Marc4DAMASK) || defined(Abaqus) !-------------------------------------------------------------------------------------------------- !> @brief Gives the FE to CP ID mapping by binary search through lookup array !! valid questions (what) are 'elem', 'node' @@ -713,7 +718,7 @@ integer(pInt) function mesh_FEasCP(what,myID) enddo binarySearch end function mesh_FEasCP - +#endif !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -1188,24 +1193,6 @@ subroutine mesh_spectral_count() end subroutine mesh_spectral_count -!-------------------------------------------------------------------------------------------------- -!> @brief fake map node from FE ID to internal (consecutive) representation for node and element -!! Allocates global array 'mesh_mapFEtoCPnode' and 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_mapNodesAndElems - use math, only: & - math_range - - implicit none - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source = 0_pInt) - allocate (mesh_mapFEtoCPelem(2_pInt,mesh_NcpElems), source = 0_pInt) - - mesh_mapFEtoCPnode = spread(math_range(mesh_Nnodes),1,2) - mesh_mapFEtoCPelem = spread(math_range(mesh_NcpElems),1,2) - -end subroutine mesh_spectral_mapNodesAndElems - - !-------------------------------------------------------------------------------------------------- !> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. !! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', diff --git a/src/meshFEM.f90 b/src/meshFEM.f90 index 141b1b0a9..7d79dd46d 100644 --- a/src/meshFEM.f90 +++ b/src/meshFEM.f90 @@ -154,12 +154,6 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - if (allocated(mesh_node0)) deallocate(mesh_node0) - if (allocated(mesh_node)) deallocate(mesh_node) - if (allocated(mesh_element)) deallocate(mesh_element) - if (allocated(mesh_ipCoordinates)) deallocate(mesh_ipCoordinates) - if (allocated(mesh_ipVolume)) deallocate(mesh_ipVolume) - call DMPlexCreateFromFile(PETSC_COMM_WORLD,geometryFile,PETSC_TRUE,globalMesh,ierr) CHKERRQ(ierr) call DMGetDimension(globalMesh,dimPlex,ierr) @@ -334,11 +328,9 @@ subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints) PetscInt :: cellStart, cellEnd, cell, qPt, dirI, dirJ, qOffset PetscErrorCode :: ierr - if (.not. allocated(mesh_ipCoordinates)) then - allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems)) - mesh_ipCoordinates = 0.0_pReal - endif - + + allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + pV0 => v0 pCellJ => cellJ pInvcellJ => invcellJ From dbed7056e5d96847b5ce23f6b03c319458973220 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 17:07:20 +0200 Subject: [PATCH 136/208] [skip sc] cleaning --- src/CPFEM2.f90 | 12 +----------- src/FEM_utilities.f90 | 3 +-- 2 files changed, 2 insertions(+), 13 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 9f75bf8c6..89e65f5fd 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -196,7 +196,7 @@ end subroutine CPFEM_init !-------------------------------------------------------------------------------------------------- -!> @brief perform initialization at first call, update variables and call the actual material model +!> @brief forwards data after successful increment !-------------------------------------------------------------------------------------------------- subroutine CPFEM_age() use prec, only: & @@ -212,16 +212,6 @@ subroutine CPFEM_age() debug_levelSelective use FEsolving, only: & restartWrite - use math, only: & - math_identity2nd, & - math_mul33x33, & - math_det33, & - math_transpose33, & - math_I3, & - math_Mandel3333to66, & - math_Mandel66to3333, & - math_Mandel33to6, & - math_Mandel6to33 use material, only: & plasticState, & sourceState, & diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index 4947fb0c7..f911835ac 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -469,8 +469,7 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) real(pReal) :: defgradDetMin, defgradDetMax, defgradDet PetscErrorCode :: ierr - if (worldrank == 0) & - write(6,'(/,a)') ' ... evaluating constitutive response ......................................' + write(6,'(/,a)') ' ... evaluating constitutive response ......................................' age = .False. if (forwardData) then ! aging results From 031c59954f80a7113023d119ea52ff2adb817c65 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 17:45:34 +0200 Subject: [PATCH 137/208] working directory is changed automatically --- src/HDF5_utilities.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index ca75d6aff..e2b0c2450 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -53,7 +53,6 @@ end subroutine HDF5_Utilities_init subroutine HDF5_createJobFile use hdf5 use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -84,7 +83,7 @@ subroutine HDF5_createJobFile !-------------------------------------------------------------------------------------------------- ! open file - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//'hdf5' + path = trim(getSolverJobName())//'.'//'hdf5' !call h5fcreate_f(path,H5F_ACC_TRUNC_F,resultsFile,hdferr) call h5fcreate_f(path,H5F_ACC_TRUNC_F,resultsFile,hdferr,access_prp = plist_id) if (hdferr < 0) call IO_error(100_pInt,ext_msg=path) From e47677738a8166a21abfe7db7b0558056e5c5aa4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 17:57:15 +0200 Subject: [PATCH 138/208] more verbose error --- src/DAMASK_interface.f90 | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index e859c0f5a..f5e585b7e 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -45,8 +45,23 @@ subroutine DAMASK_interface_init() iso_fortran_env #include #if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINOR!=9 -=================================================================================================== +=================================================================================================== + 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x +=================================================================================================== +======= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x =========================================== +========== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ======================================== +============= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ===================================== +================ THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ================================== +=================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x =============================== +====================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ============================ ========================= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ========================= +============================ THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ====================== +=============================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x =================== +================================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ================ +===================================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ============= +======================================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ========== +=================================================================================================== + 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x =================================================================================================== #endif use PETScSys From c78396dd781c4009525d77f280a49b7808f8e1a4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 22:11:53 +0200 Subject: [PATCH 139/208] randomized FILEUNIT matrix inversion error when numerics.config is not there or not present very strange --- src/constitutive.f90 | 2 +- src/debug.f90 | 2 +- src/material.f90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 7833f70cf..ce09c86a0 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -138,7 +138,7 @@ subroutine constitutive_init() use kinematics_hydrogen_strain implicit none - integer(pInt), parameter :: FILEUNIT = 200_pInt + integer(pInt), parameter :: FILEUNIT = 204_pInt integer(pInt) :: & o, & !< counter in output loop ph, & !< counter in phase loop diff --git a/src/debug.f90 b/src/debug.f90 index 55cc62ca0..2a4edf28e 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -102,7 +102,7 @@ subroutine debug_init IO_EOF implicit none - integer(pInt), parameter :: FILEUNIT = 300_pInt + integer(pInt), parameter :: FILEUNIT = 330_pInt integer(pInt) :: i, what integer(pInt), allocatable, dimension(:) :: chunkPos diff --git a/src/material.f90 b/src/material.f90 index c2c52aaa6..4c5a9ed74 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -370,7 +370,7 @@ subroutine material_init() FE_geomtype implicit none - integer(pInt), parameter :: FILEUNIT = 200_pInt + integer(pInt), parameter :: FILEUNIT = 210_pInt integer(pInt) :: m,c,h, myDebug, myPhase, myHomog integer(pInt) :: & g, & !< grain number From 87a8a9536ba0fc9dd9f084df8fe7e1a358f30277 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Mon, 20 Aug 2018 16:34:43 -0400 Subject: [PATCH 140/208] absTol for divergence was way too tight --- src/numerics.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/numerics.f90 b/src/numerics.f90 index 56da2041e..6866a89ad 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -94,7 +94,7 @@ module numerics ! spectral parameters: #ifdef Spectral real(pReal), protected, public :: & - err_div_tolAbs = 1.0e-10_pReal, & !< absolute tolerance for equilibrium + err_div_tolAbs = 1.0e-4_pReal, & !< absolute tolerance for equilibrium err_div_tolRel = 5.0e-4_pReal, & !< relative tolerance for equilibrium err_curl_tolAbs = 1.0e-10_pReal, & !< absolute tolerance for compatibility err_curl_tolRel = 5.0e-4_pReal, & !< relative tolerance for compatibility From 69ad600916f44a701c5d1777dfe7f818c8e0b7b3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 22:36:55 +0200 Subject: [PATCH 141/208] more explicit file opening still having trouble with Gfortran 7.3 and no numerics.config --- src/IO.f90 | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index c9e93b498..4a61f25c1 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -153,7 +153,7 @@ recursive function IO_read(fileUnit,reset) result(line) pathOn(stack) = path(1:scan(path,SEP,.true.))//input ! glue include to current file's dir endif - open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack),action='read') ! open included file + open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack),action='read',status='old',position='rewind') ! open included file if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=pathOn(stack)) line = IO_read(fileUnit) @@ -193,14 +193,17 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent) myTotalLines, & !< # lines read from file without include statements includedLines, & !< # lines included from other file(s) missingLines, & !< # lines missing from current file - l,i + l,i, & + myStat if (merge(cnt,0_pInt,present(cnt))>10_pInt) call IO_error(106_pInt,ext_msg=trim(fileName)) !-------------------------------------------------------------------------------------------------- ! read data as stream inquire(file = fileName, size=fileLength) - open(newunit=fileUnit, file = fileName, access = "STREAM") + open(newunit=fileUnit, file=fileName, access='stream',& + status='old', position='rewind', action='read',iostat=myStat) + if(myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=trim(fileName)) allocate(character(len=fileLength)::rawData) read(fileUnit) rawData close(fileUnit) @@ -276,7 +279,7 @@ subroutine IO_open_file(fileUnit,path) integer(pInt) :: myStat - open(fileUnit,status='old',iostat=myStat,file=path) + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) end subroutine IO_open_file @@ -295,7 +298,8 @@ logical function IO_open_file_stat(fileUnit,path) integer(pInt) :: myStat - open(fileUnit,status='old',iostat=myStat,file=path) + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') + if (myStat /= 0_pInt) close(fileUnit) IO_open_file_stat = (myStat == 0_pInt) end function IO_open_file_stat @@ -319,7 +323,7 @@ subroutine IO_open_jobFile(fileUnit,ext) character(len=1024) :: path path = trim(getSolverJobName())//'.'//ext - open(fileUnit,status='old',iostat=myStat,file=path) + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) end subroutine IO_open_jobFile @@ -343,7 +347,8 @@ logical function IO_open_jobFile_stat(fileUnit,ext) character(len=1024) :: path path = trim(getSolverJobName())//'.'//ext - open(fileUnit,status='old',iostat=myStat,file=path) + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') + if (myStat /= 0_pInt) close(fileUnit) IO_open_jobFile_stat = (myStat == 0_pInt) end function IO_open_JobFile_stat @@ -369,11 +374,11 @@ subroutine IO_open_inputFile(fileUnit,modelName) fileType = 1_pInt ! assume .pes path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used - open(fileUnit+1,status='old',iostat=myStat,file=path) + open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') if(myStat /= 0_pInt) then ! if .pes does not work / exist; use conventional extension, i.e.".inp" fileType = 2_pInt path = trim(modelName)//inputFileExtension(fileType) - open(fileUnit+1,status='old',iostat=myStat,file=path) + open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') endif if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -408,7 +413,7 @@ subroutine IO_open_logFile(fileUnit) character(len=1024) :: path path = trim(getSolverJobName())//LogFileExtension - open(fileUnit,status='old',iostat=myStat,file=path) + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) end subroutine IO_open_logFile From 60f56255e4db846068b6c8f9e01bee2c5f47a76f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 23:14:34 +0200 Subject: [PATCH 142/208] [skip sc] [skip ci] simplified interfacing --- src/DAMASK_interface.f90 | 81 ++++++++++++++++------------------------ src/DAMASK_spectral.f90 | 15 +++----- src/system_routines.f90 | 49 +++++++++++++----------- 3 files changed, 65 insertions(+), 80 deletions(-) diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index f5e585b7e..8d146c014 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -15,12 +15,11 @@ module DAMASK_interface implicit none private - logical, public, protected :: interface_appendToOutFile = .false. !< Append to existing spectralOut file (in case of restart, not in case of regridding) - integer(pInt), public, protected :: interface_restartInc = 0_pInt !< Increment at which calculation starts + integer(pInt), public, protected :: & + interface_restartInc = 0_pInt !< Increment at which calculation starts character(len=1024), public, protected :: & geometryFile = '', & !< parameter given for geometry file loadCaseFile = '' !< parameter given for load case file - character(len=1024), private :: workingDirectory public :: & getSolverJobName, & @@ -66,7 +65,8 @@ subroutine DAMASK_interface_init() #endif use PETScSys use system_routines, only: & - getHostName + getHostName, & + getCWD implicit none character(len=1024) :: & @@ -74,9 +74,7 @@ subroutine DAMASK_interface_init() loadcaseArg = '', & !< -l argument given to the executable geometryArg = '', & !< -g argument given to the executable workingDirArg = '', & !< -w argument given to the executable - hostName, & !< name of machine (might require export HOSTNAME) - userName, & !< name of user calling the executable - tag + userName !< name of user calling the executable integer :: & i, & #ifdef _OPENMP @@ -89,7 +87,6 @@ subroutine DAMASK_interface_init() integer, dimension(8) :: & dateAndTime ! type default integer PetscErrorCode :: ierr - logical :: error external :: & quit,& PETScErrorF, & ! is called in the CHKERRQ macro @@ -189,7 +186,6 @@ subroutine DAMASK_interface_init() case ('-r', '--rs', '--restart') if (i < chunkPos(1)) then interface_restartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) - interface_appendToOutFile = .true. endif end select enddo @@ -199,26 +195,25 @@ subroutine DAMASK_interface_init() call quit(1_pInt) endif - workingDirectory = trim(setWorkingDirectory(trim(workingDirArg))) + if (len_trim(workingDirArg) > 0) call setWorkingDirectory(trim(workingDirArg)) geometryFile = getGeometryFile(geometryArg) loadCaseFile = getLoadCaseFile(loadCaseArg) call get_environment_variable('USER',userName) - error = getHostName(hostName) - write(6,'(a,a)') ' Host name: ', trim(hostName) + ! ToDo: https://stackoverflow.com/questions/8953424/how-to-get-the-username-in-c-c-in-linux + write(6,'(a,a)') ' Host name: ', trim(getHostName()) write(6,'(a,a)') ' User name: ', trim(userName) write(6,'(a,a)') ' Command line call: ', trim(commandLine) if (len(trim(workingDirArg)) > 0) & write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg) - write(6,'(a,a)') ' Working directory: ', trim(workingDirectory) + write(6,'(a,a)') ' Working directory: ', trim(getCWD()) write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) if (interface_restartInc > 0_pInt) & write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc - write(6,'(a,l1,/)') ' Append to result file: ', interface_appendToOutFile end subroutine DAMASK_interface_init @@ -227,38 +222,32 @@ end subroutine DAMASK_interface_init !> @brief extract working directory from given argument or from location of geometry file, !! possibly converting relative arguments to absolut path !-------------------------------------------------------------------------------------------------- -character(len=1024) function setWorkingDirectory(workingDirectoryArg) +subroutine setWorkingDirectory(workingDirectoryArg) use system_routines, only: & getCWD, & setCWD implicit none character(len=*), intent(in) :: workingDirectoryArg !< working directory argument - logical :: error + character(len=1024) :: workingDirectory !< working directory argument external :: quit + logical :: error - wdGiven: if (len(workingDirectoryArg)>0) then - absolutePath: if (workingDirectoryArg(1:1) == '/') then - setWorkingDirectory = workingDirectoryArg - else absolutePath - error = getCWD(setWorkingDirectory) - if (error) call quit(1_pInt) - setWorkingDirectory = trim(setWorkingDirectory)//'/'//workingDirectoryArg - endif absolutePath - else wdGiven - error = getCWD(setWorkingDirectory) ! relative path given as command line argument - if (error) call quit(1_pInt) - endif wdGiven + absolutePath: if (workingDirectoryArg(1:1) == '/') then + workingDirectory = workingDirectoryArg + else absolutePath + workingDirectory = getCWD() + workingDirectory = trim(workingDirectory)//'/'//workingDirectoryArg + endif absolutePath - setWorkingDirectory = trim(rectifyPath(setWorkingDirectory)) - - error = setCWD(trim(setWorkingDirectory)) + workingDirectory = trim(rectifyPath(workingDirectory)) + error = setCWD(trim(workingDirectory)) if(error) then - write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist' + write(6,'(a20,a,a16)') ' working directory "',trim(workingDirectory),'" does not exist' call quit(1_pInt) endif -end function setWorkingDirectory +end subroutine setWorkingDirectory !-------------------------------------------------------------------------------------------------- @@ -290,18 +279,15 @@ end function getSolverJobName !> @brief basename of geometry file with extension from command line arguments !-------------------------------------------------------------------------------------------------- character(len=1024) function getGeometryFile(geometryParameter) + use system_routines, only: & + getCWD implicit none - character(len=1024), intent(in) :: & - geometryParameter - external :: quit + character(len=1024), intent(in) :: geometryParameter getGeometryFile = trim(geometryParameter) - - if (scan(getGeometryFile,'/') /= 1) & - getGeometryFile = trim(workingDirectory)//'/'//trim(getGeometryFile) - - getGeometryFile = makeRelativePath(workingDirectory, getGeometryFile) + if (scan(getGeometryFile,'/') /= 1) getGeometryFile = trim(getCWD())//'/'//trim(getGeometryFile) + getGeometryFile = makeRelativePath(trim(getCWD()), getGeometryFile) end function getGeometryFile @@ -311,18 +297,15 @@ end function getGeometryFile !> @brief relative path of loadcase from command line arguments !-------------------------------------------------------------------------------------------------- character(len=1024) function getLoadCaseFile(loadCaseParameter) + use system_routines, only: & + getCWD implicit none - character(len=1024), intent(in) :: & - loadCaseParameter - external :: quit + character(len=1024), intent(in) :: loadCaseParameter getLoadCaseFile = trim(loadCaseParameter) - - if (scan(getLoadCaseFile,'/') /= 1) & - getLoadCaseFile = trim(workingDirectory)//'/'//trim(getLoadCaseFile) - - getLoadCaseFile = makeRelativePath(workingDirectory, getLoadCaseFile) + if (scan(getLoadCaseFile,'/') /= 1) getLoadCaseFile = trim(getCWD())//'/'//trim(getLoadCaseFile) + getLoadCaseFile = makeRelativePath(trim(getCWD()), getLoadCaseFile) end function getLoadCaseFile diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 86c2f61e2..7f968a7f5 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -20,14 +20,12 @@ program DAMASK_spectral pReal, & tol_math_check, & dNeq - use system_routines, only: & - getCWD use DAMASK_interface, only: & DAMASK_interface_init, & loadCaseFile, & geometryFile, & getSolverJobName, & - interface_appendToOutFile + interface_restartInc use IO, only: & IO_read, & IO_isBlank, & @@ -383,8 +381,7 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! write header of output file if (worldrank == 0) then - if (.not. interface_appendToOutFile) then ! after restart, append to existing results file - if (getCWD(workingDir)) call IO_error(106_pInt,ext_msg=trim(workingDir)) + writeHeader: if (interface_restartInc < 1_pInt) then open(newunit=resUnit,file=trim(getSolverJobName())//& '.spectralOut',form='UNFORMATTED',status='REPLACE') write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header @@ -407,10 +404,10 @@ program DAMASK_spectral if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) & write(6,'(/,a)') ' header of result and statistics file written out' flush(6) - else ! open new files ... + else writeHeader open(newunit=statUnit,file=trim(getSolverJobName())//& '.sta',form='FORMATTED', position='APPEND', status='OLD') - endif + endif writeHeader endif !-------------------------------------------------------------------------------------------------- @@ -431,7 +428,7 @@ program DAMASK_spectral call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek') - if (.not. interface_appendToOutFile) then ! if not restarting, write 0th increment + writeUndeformed: if (interface_restartInc < 1_pInt) then write(6,'(1/,a)') ' ... writing initial configuration to file ........................' do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1? @@ -443,7 +440,7 @@ program DAMASK_spectral if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write') enddo fileOffset = fileOffset + sum(outputSize) ! forward to current file position - endif + endif writeUndeformed !-------------------------------------------------------------------------------------------------- ! looping over loadcases loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) diff --git a/src/system_routines.f90 b/src/system_routines.f90 index 2740011b4..662751067 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -78,28 +78,31 @@ end function isDirectory !-------------------------------------------------------------------------------------------------- !> @brief gets the current working directory !-------------------------------------------------------------------------------------------------- -logical function getCWD(str) +character(len=1024) function getCWD() use, intrinsic :: ISO_C_Binding, only: & C_INT, & C_CHAR, & C_NULL_CHAR implicit none - character(len=*), intent(out) :: str character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array integer(C_INT) :: stat integer :: i - str = repeat('',len(str)) call getCurrentWorkDir_C(strFixedLength,stat) - do i=1,1024 ! copy array components until Null string is found - if (strFixedLength(i) /= C_NULL_CHAR) then - str(i:i)=strFixedLength(i) - else - exit - endif - enddo - getCWD=merge(.True.,.False.,stat /= 0_C_INT) + if (stat /= 0_C_INT) then + getCWD = 'Error occured when getting currend working directory' + else + getCWD = repeat('',len(getCWD)) + do i=1,1024 ! copy array components until Null string is found + if (strFixedLength(i) /= C_NULL_CHAR) then + getCWD(i:i)=strFixedLength(i) + else + getCWD(i:i)=char(0) + exit + endif + enddo + endif end function getCWD @@ -107,28 +110,30 @@ end function getCWD !-------------------------------------------------------------------------------------------------- !> @brief gets the current host name !-------------------------------------------------------------------------------------------------- -logical function getHostName(str) +character(len=1024) function getHostName() use, intrinsic :: ISO_C_Binding, only: & C_INT, & C_CHAR, & C_NULL_CHAR implicit none - character(len=*), intent(out) :: str character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array integer(C_INT) :: stat integer :: i - str = repeat('',len(str)) call getHostName_C(strFixedLength,stat) - do i=1,1024 ! copy array components until Null string is found - if (strFixedLength(i) /= C_NULL_CHAR) then - str(i:i)=strFixedLength(i) - else - exit - endif - enddo - getHostName=merge(.True.,.False.,stat /= 0_C_INT) + if (stat /= 0_C_INT) then + getHostName = 'Error occured when getting host name' + else + getHostName = repeat('',len(getHostName)) + do i=1,1024 ! copy array components until Null string is found + if (strFixedLength(i) /= C_NULL_CHAR) then + getHostName(i:i)=strFixedLength(i) + else + exit + endif + enddo + endif end function getHostName From 465d950ab173b6a3ceeb372b1e62298a20f6c2b5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 21 Aug 2018 07:09:50 +0200 Subject: [PATCH 143/208] gfortran 7.3 and optimized code still gives 'terminally ill' --- src/plastic_phenopowerlaw.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index bdc6e12a6..59a106435 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -241,29 +241,29 @@ subroutine plastic_phenopowerlaw_init select case(outputs(i)) case ('resistance_slip') outputID = resistance_slip_ID - outputSize = sum(prm%Nslip) + outputSize = prm%totalNslip case ('accumulatedshear_slip') outputID = accumulatedshear_slip_ID - outputSize = sum(prm%Nslip) + outputSize = prm%totalNslip case ('shearrate_slip') outputID = shearrate_slip_ID - outputSize = sum(prm%Nslip) + outputSize = prm%totalNslip case ('resolvedstress_slip') outputID = resolvedstress_slip_ID - outputSize = sum(prm%Nslip) + outputSize = prm%totalNslip case ('resistance_twin') outputID = resistance_twin_ID - outputSize = sum(prm%Ntwin) + outputSize = prm%totalNtwin case ('accumulatedshear_twin') outputID = accumulatedshear_twin_ID - outputSize = sum(prm%Ntwin) + outputSize = prm%totalNtwin case ('shearrate_twin') outputID = shearrate_twin_ID - outputSize = sum(prm%Ntwin) + outputSize = prm%totalNtwin case ('resolvedstress_twin') outputID = resolvedstress_twin_ID - outputSize = sum(prm%Ntwin) + outputSize = prm%totalNtwin case ('totalvolfrac_twin') outputID = totalvolfrac_twin_ID From d146417abec3b9fc46d572d2fd51e3067d581c8e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 21 Aug 2018 07:41:10 +0200 Subject: [PATCH 144/208] hot fix for terminally ill with gfortran 7.3 might be a bug in the compiler or in the linked list. waste some memory at the moment... check linked list carefully before enabling again and blaming gfortran --- src/config.f90 | 75 +++++++++++++++++++++++++------------------------- 1 file changed, 38 insertions(+), 37 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index c99b14c00..08d1ace5a 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -234,6 +234,7 @@ end subroutine parseFile !-------------------------------------------------------------------------------------------------- !> @brief deallocates the linked lists that store the content of the configuration files +! commenting out removes erratic errors with gfortran 7.3 !-------------------------------------------------------------------------------------------------- subroutine config_deallocate(what) use IO, only: & @@ -243,42 +244,42 @@ subroutine config_deallocate(what) character(len=*), intent(in) :: what integer(pInt) :: i - select case(what) - - case('material.config/phase') - do i=1, size(config_phase) - call config_phase(i)%free - enddo - deallocate(config_phase) - - case('material.config/microstructure') - do i=1, size(config_microstructure) - call config_microstructure(i)%free - enddo - deallocate(config_microstructure) - - case('material.config/crystallite') - do i=1, size(config_crystallite) - call config_crystallite(i)%free - enddo - deallocate(config_crystallite) - - case('material.config/homogenization') - do i=1, size(config_homogenization) - call config_homogenization(i)%free - enddo - deallocate(config_homogenization) - - case('material.config/texture') - do i=1, size(config_texture) - call config_texture(i)%free - enddo - deallocate(config_texture) - - case default - call IO_error(0_pInt,ext_msg='config_deallocate') - - end select +! select case(what) +! +! case('material.config/phase') +! do i=1, size(config_phase) +! call config_phase(i)%free +! enddo +! deallocate(config_phase) +! +! case('material.config/microstructure') +! do i=1, size(config_microstructure) +! call config_microstructure(i)%free +! enddo +! deallocate(config_microstructure) +! +! case('material.config/crystallite') +! do i=1, size(config_crystallite) +! call config_crystallite(i)%free +! enddo +! deallocate(config_crystallite) +! +! case('material.config/homogenization') +! do i=1, size(config_homogenization) +! call config_homogenization(i)%free +! enddo +! deallocate(config_homogenization) +! +! case('material.config/texture') +! do i=1, size(config_texture) +! call config_texture(i)%free +! enddo +! deallocate(config_texture) +! +! case default +! call IO_error(0_pInt,ext_msg='config_deallocate') +! +! end select end subroutine config_deallocate @@ -342,7 +343,7 @@ end subroutine show !-------------------------------------------------------------------------------------------------- !> @brief cleans entire list -!> @details list head is remains alive +!> @details list head remains alive !-------------------------------------------------------------------------------------------------- subroutine free(this) From 8de321382f94c36a66f58189c634aab81fbf35ba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 21 Aug 2018 08:14:59 +0200 Subject: [PATCH 145/208] using final seems to be the better approach http://www.training.prace-ri.eu/uploads/tx_pracetmo/AdvFTN_handout.pdf still needs in-depth analysis, even though I cannot reproduce 'terminally ill' --- src/config.f90 | 78 +++++++++++++++++++++++++------------------------- 1 file changed, 39 insertions(+), 39 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 08d1ace5a..05da341d4 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -20,11 +20,10 @@ module config type, public :: tPartitionedStringList type(tPartitionedString) :: string type(tPartitionedStringList), pointer :: next => null() - contains procedure :: add => add procedure :: show => show - procedure :: free => free + !procedure :: free => free procedure :: keyExists => keyExists procedure :: countKeys => countKeys @@ -36,6 +35,7 @@ module config procedure :: getFloats => getFloats procedure :: getInts => getInts procedure :: getStrings => getStrings + final :: free end type tPartitionedStringList @@ -244,42 +244,42 @@ subroutine config_deallocate(what) character(len=*), intent(in) :: what integer(pInt) :: i -! select case(what) -! -! case('material.config/phase') -! do i=1, size(config_phase) -! call config_phase(i)%free -! enddo -! deallocate(config_phase) -! -! case('material.config/microstructure') -! do i=1, size(config_microstructure) -! call config_microstructure(i)%free -! enddo -! deallocate(config_microstructure) -! -! case('material.config/crystallite') -! do i=1, size(config_crystallite) -! call config_crystallite(i)%free -! enddo -! deallocate(config_crystallite) -! -! case('material.config/homogenization') -! do i=1, size(config_homogenization) -! call config_homogenization(i)%free -! enddo -! deallocate(config_homogenization) -! -! case('material.config/texture') -! do i=1, size(config_texture) -! call config_texture(i)%free -! enddo -! deallocate(config_texture) -! -! case default -! call IO_error(0_pInt,ext_msg='config_deallocate') -! -! end select + select case(what) + + case('material.config/phase') + !do i=1, size(config_phase) + ! call config_phase(i)%free + !enddo + deallocate(config_phase) + + case('material.config/microstructure') + !do i=1, size(config_microstructure) + ! call config_microstructure(i)%free + !enddo + deallocate(config_microstructure) + + case('material.config/crystallite') + !do i=1, size(config_crystallite) + ! call config_crystallite(i)%free + !enddo + deallocate(config_crystallite) + + case('material.config/homogenization') + !do i=1, size(config_homogenization) + ! call config_homogenization(i)%free + !enddo + deallocate(config_homogenization) + + case('material.config/texture') + !do i=1, size(config_texture) + ! call config_texture(i)%free + !enddo + deallocate(config_texture) + + case default + call IO_error(0_pInt,ext_msg='config_deallocate') + + end select end subroutine config_deallocate @@ -348,7 +348,7 @@ end subroutine show subroutine free(this) implicit none - class(tPartitionedStringList), target, intent(in) :: this + type(tPartitionedStringList), target, intent(in) :: this type(tPartitionedStringList), pointer :: new, item if (.not. associated(this%next)) return From c6ed69cb77426620d721ce87600a6f0c53d5b418 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 21 Aug 2018 09:47:03 +0200 Subject: [PATCH 146/208] [skip ci] updated version information after successful test of v2.0.2-390-g7c683d4f --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index fea0a6cd0..0f2fd848d 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-381-gc03ea8f5 +v2.0.2-390-g7c683d4f From 179a23f55b8f026ad14f1680633a4ad33cc12722 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 21 Aug 2018 22:49:56 +0200 Subject: [PATCH 147/208] IMKL needed for MSC.Marc --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index d3068c454..be8eb3465 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -47,7 +47,7 @@ variables: # =============================================================================================== # ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++ IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016" - IntelCompiler16_4: "Compiler/Intel/16.4" + IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016-4" IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017" IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018" GNUCompiler7_3: "Compiler/GNU/7.3" From 51dbc6c445c59c20b1f3b8f82fc308ead4c97c2a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 21 Aug 2018 22:58:54 +0200 Subject: [PATCH 148/208] test compatible with 39-branch --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index c44717258..ce48785dc 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c4471725893e301044924eb0990e2ad619aa0a46 +Subproject commit ce48785dcc5c9cae28cd35d45b612223c37c73b0 From a8788b65e5cc3a584f652c1eff8aa7e067dd0068 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 22 Aug 2018 06:26:29 +0200 Subject: [PATCH 149/208] [skip ci] updated version information after successful test of v2.0.2-391-g87a8a953 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index fea0a6cd0..e57b32ff9 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-381-gc03ea8f5 +v2.0.2-391-g87a8a953 From 52002f654e512acd2366f374f28fabae05e927b1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 09:14:16 +0200 Subject: [PATCH 150/208] to converge at one point to one (or two) string lenth values --- src/prec.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/prec.f90 b/src/prec.f90 index caf59cfe8..959ee77ba 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -23,6 +23,7 @@ module prec NO SUITABLE PRECISION FOR INTEGER SELECTED, STOPPING COMPILATION #endif + integer, parameter, public :: pStringLen = 256 !< default string lenth integer, parameter, public :: pLongInt = 8 !< integer representation 64 bit (was selected_int_kind(12), number with at least up to +- 1e12) real(pReal), parameter, public :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation) From 52088691d1d441bfbc0bc83fc9fda91a1c688408 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 11:51:23 +0200 Subject: [PATCH 151/208] improved linked list and fixed solution for strange bug Bug: Using automated LHS re-allocation for a string array that with global scope seems to cause trouble Hence, "parse_file" works with a local string and assings only once to it Linked_List: Now storing data in the list head also and last element is always empty. Finalize allows simple handling of deallocation --- src/config.f90 | 223 ++++++++++++++++++++++------------------- src/constitutive.f90 | 4 +- src/crystallite.f90 | 5 +- src/homogenization.f90 | 3 +- src/material.f90 | 10 +- 5 files changed, 131 insertions(+), 114 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 05da341d4..a22acbff9 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -23,7 +23,13 @@ module config contains procedure :: add => add procedure :: show => show - !procedure :: free => free + procedure :: free => free + +! currently, a finalize is needed for all shapes of tPartitionedStringList. +! with Fortran 2015, we can define one recursive elemental function +! https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/543326 + final :: finalize, & + finalizeArray procedure :: keyExists => keyExists procedure :: countKeys => countKeys @@ -35,13 +41,13 @@ module config procedure :: getFloats => getFloats procedure :: getInts => getInts procedure :: getStrings => getStrings - final :: free + end type tPartitionedStringList type(tPartitionedStringList), public :: emptyList - type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & ! QUESTION: rename to config_XXX? + type(tPartitionedStringList), public, allocatable, dimension(:) :: & config_phase, & config_microstructure, & config_homogenization, & @@ -78,8 +84,7 @@ module config public :: & - config_init, & - config_deallocate + config_init contains @@ -92,6 +97,8 @@ subroutine config_init() compiler_version, & compiler_options #endif + use prec, only: & + pStringLen use DAMASK_interface, only: & getSolverJobName use IO, only: & @@ -109,10 +116,10 @@ subroutine config_init() implicit none integer(pInt) :: myDebug,i - character(len=256) :: & + character(len=pStringLen) :: & line, & part - character(len=256), dimension(:), allocatable :: fileContent + character(len=pStringLen), dimension(:), allocatable :: fileContent logical :: fileExists write(6,'(/,a)') ' <<<+- config init -+>>>' @@ -175,8 +182,10 @@ end subroutine config_init !-------------------------------------------------------------------------------------------------- !> @brief parses the material.config file !-------------------------------------------------------------------------------------------------- -subroutine parseFile(line,& - sectionNames,part,fileContent) +subroutine parseFile(line,sectionNames,part,& + fileContent) + use prec, only: & + pStringLen use IO, only: & IO_error, & IO_lc, & @@ -186,11 +195,12 @@ subroutine parseFile(line,& IO_stringPos implicit none - character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames + character(len=pStringLen), intent(out) :: line + character(len=64), allocatable, dimension(:), intent(out) :: sectionNames type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part - character(len=256), dimension(:), intent(in) :: fileContent - character(len=256),intent(out) :: line + character(len=pStringLen), dimension(:), intent(in) :: fileContent + character(len=64), allocatable, dimension(:) :: sectionNamesTemp ! Circumvent Gfortran bug integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: s,i character(len=64) :: tag @@ -198,6 +208,8 @@ subroutine parseFile(line,& echo = .false. allocate(part(0)) + tag='' + allocate(sectionNamesTemp(0),source=tag) s = 0_pInt do i=1, size(fileContent) @@ -208,11 +220,7 @@ subroutine parseFile(line,& s = s + 1_pInt part = [part, emptyList] tag = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(sectionNames)) then - allocate(sectionNames(1),source=tag) - else GfortranBug86033 - sectionNames = [sectionNames,tag] - endif GfortranBug86033 + sectionNamesTemp = [sectionNamesTemp,tag] cycle endif nextSection chunkPos = IO_stringPos(line) @@ -224,8 +232,11 @@ subroutine parseFile(line,& endif inSection enddo + sectionNames = sectionNamesTemp + if (echo) then do s = 1, size(sectionNames) + write(6,*) 'section',s, '"'//trim(sectionNames(i))//'"' call part(s)%show() end do end if @@ -234,7 +245,6 @@ end subroutine parseFile !-------------------------------------------------------------------------------------------------- !> @brief deallocates the linked lists that store the content of the configuration files -! commenting out removes erratic errors with gfortran 7.3 !-------------------------------------------------------------------------------------------------- subroutine config_deallocate(what) use IO, only: & @@ -244,36 +254,21 @@ subroutine config_deallocate(what) character(len=*), intent(in) :: what integer(pInt) :: i - select case(what) + select case(trim(what)) case('material.config/phase') - !do i=1, size(config_phase) - ! call config_phase(i)%free - !enddo deallocate(config_phase) case('material.config/microstructure') - !do i=1, size(config_microstructure) - ! call config_microstructure(i)%free - !enddo deallocate(config_microstructure) case('material.config/crystallite') - !do i=1, size(config_crystallite) - ! call config_crystallite(i)%free - !enddo deallocate(config_crystallite) case('material.config/homogenization') - !do i=1, size(config_homogenization) - ! call config_homogenization(i)%free - !enddo deallocate(config_homogenization) case('material.config/texture') - !do i=1, size(config_texture) - ! call config_texture(i)%free - !enddo deallocate(config_texture) case default @@ -294,7 +289,7 @@ end subroutine config_deallocate !> @brief add element !> @details Adds a string together with the start/end position of chunks in this string. The new !! element is added at the end of the list. Empty strings are not added. All strings are converted -!! to lower case +!! to lower case. The data is not stored in the new element but in the current. !-------------------------------------------------------------------------------------------------- subroutine add(this,string) use IO, only: & @@ -305,19 +300,18 @@ subroutine add(this,string) implicit none class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: string - type(tPartitionedStringList), pointer :: new, item + type(tPartitionedStringList), pointer :: new, temp if (IO_isBlank(string)) return allocate(new) - new%string%val = IO_lc (trim(string)) - new%string%pos = IO_stringPos(trim(string)) - - item => this - do while (associated(item%next)) - item => item%next + temp => this + do while (associated(temp%next)) + temp => temp%next enddo - item%next => new + temp%string%val = IO_lc (trim(string)) + temp%string%pos = IO_stringPos(trim(string)) + temp%next => new end subroutine add @@ -329,11 +323,11 @@ end subroutine add subroutine show(this) implicit none - class(tPartitionedStringList) :: this - type(tPartitionedStringList), pointer :: item + class(tPartitionedStringList), target, intent(in) :: this + type(tPartitionedStringList), pointer :: item - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) write(6,'(a)') trim(item%string%val) item => item%next end do @@ -343,27 +337,54 @@ end subroutine show !-------------------------------------------------------------------------------------------------- !> @brief cleans entire list -!> @details list head remains alive +!> @details explicit interface to reset list. Triggers final statement (and following chain reaction) !-------------------------------------------------------------------------------------------------- subroutine free(this) implicit none - type(tPartitionedStringList), target, intent(in) :: this - type(tPartitionedStringList), pointer :: new, item + class(tPartitionedStringList), intent(inout) :: this - if (.not. associated(this%next)) return - - item => this%next - do while (associated(item%next)) - new => item - deallocate(item) - item => new%next - enddo - deallocate(item) + if(associated(this%next)) deallocate(this%next) end subroutine free +!-------------------------------------------------------------------------------------------------- +!> @brief cleans entire list +!> @details called when variable goes out of scope. Triggers chain reaction. +!-------------------------------------------------------------------------------------------------- +recursive subroutine finalize(this) + + implicit none + type(tPartitionedStringList), intent(inout) :: this + + if(associated(this%next)) deallocate(this%next) + +end subroutine finalize + + +!-------------------------------------------------------------------------------------------------- +!> @brief cleans entire list +!> @details called when variable goes out of scope. Triggers chain reaction. +!-------------------------------------------------------------------------------------------------- +subroutine finalizeArray(this) + + implicit none + integer :: i + type(tPartitionedStringList), intent(inout), dimension(:) :: this + type(tPartitionedStringList), pointer :: temp ! bug in Gfortran + + do i=1, size(this) + if (associated(this(i)%next)) then + temp => this(i)%next + !deallocate(this(i)) !internal compiler error: in gfc_build_final_call, at fortran/trans.c:975 + deallocate(temp) + endif + enddo + +end subroutine finalizeArray + + !-------------------------------------------------------------------------------------------------- !> @brief reports wether a given key (string value at first position) exists in the list !-------------------------------------------------------------------------------------------------- @@ -372,14 +393,14 @@ logical function keyExists(this,key) IO_stringValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: item + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: item keyExists = .false. - item => this%next - do while (associated(item) .and. .not. keyExists) + item => this + do while (associated(item%next) .and. .not. keyExists) keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) item => item%next end do @@ -397,14 +418,14 @@ integer(pInt) function countKeys(this,key) implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: item + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: item countKeys = 0_pInt - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) & countKeys = countKeys + 1_pInt item => item%next @@ -425,17 +446,17 @@ real(pReal) function getFloat(this,key,defaultVal) IO_FloatValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - real(pReal), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - logical :: found + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + real(pReal), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + logical :: found found = present(defaultVal) if (found) getFloat = defaultVal - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) @@ -461,17 +482,17 @@ integer(pInt) function getInt(this,key,defaultVal) IO_IntValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - integer(pInt), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - logical :: found + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + integer(pInt), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + logical :: found found = present(defaultVal) if (found) getInt = defaultVal - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) @@ -497,13 +518,13 @@ character(len=65536) function getString(this,key,defaultVal,raw) IO_stringValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - character(len=65536), intent(in), optional :: defaultVal - logical, intent(in), optional :: raw - type(tPartitionedStringList), pointer :: item - logical :: found, & - whole + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + character(len=65536), intent(in), optional :: defaultVal + logical, intent(in), optional :: raw + type(tPartitionedStringList), pointer :: item + logical :: found, & + whole whole = merge(raw,.false.,present(raw)) ! whole string or white space splitting found = present(defaultVal) @@ -512,8 +533,8 @@ character(len=65536) function getString(this,key,defaultVal,raw) if (len_trim(getString) /= len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString') endif - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) @@ -545,7 +566,7 @@ function getFloats(this,key,defaultVal,requiredShape) implicit none real(pReal), dimension(:), allocatable :: getFloats - class(tPartitionedStringList), intent(in) :: this + class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key real(pReal), dimension(:), intent(in), optional :: defaultVal integer(pInt), dimension(:), intent(in), optional :: requiredShape @@ -559,8 +580,8 @@ function getFloats(this,key,defaultVal,requiredShape) allocate(getFloats(0)) - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (.not. cumulative) getFloats = [real(pReal)::] @@ -592,7 +613,7 @@ function getInts(this,key,defaultVal,requiredShape) implicit none integer(pInt), dimension(:), allocatable :: getInts - class(tPartitionedStringList), intent(in) :: this + class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key integer(pInt), dimension(:), intent(in), optional :: defaultVal, & requiredShape @@ -606,8 +627,8 @@ function getInts(this,key,defaultVal,requiredShape) allocate(getInts(0)) - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (.not. cumulative) getInts = [integer(pInt)::] @@ -639,7 +660,7 @@ function getStrings(this,key,defaultVal,requiredShape,raw) implicit none character(len=65536),dimension(:), allocatable :: getStrings - class(tPartitionedStringList), intent(in) :: this + class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key character(len=65536),dimension(:), intent(in), optional :: defaultVal integer(pInt), dimension(:), intent(in), optional :: requiredShape @@ -655,8 +676,8 @@ function getStrings(this,key,defaultVal,requiredShape,raw) whole = merge(raw,.false.,present(raw)) found = .false. - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index ce09c86a0..f27edcc07 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -58,7 +58,7 @@ subroutine constitutive_init() IO_write_jobIntFile, & IO_timeStamp use config, only: & - config_deallocate + config_phase use mesh, only: & FE_geomtype use config, only: & @@ -192,7 +192,7 @@ subroutine constitutive_init() if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) close(FILEUNIT) - call config_deallocate('material.config/phase') + deallocate(config_phase) write(6,'(/,a)') ' <<<+- constitutive init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0ee71b5de..6601fe29e 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -173,8 +173,7 @@ subroutine crystallite_init use material use config, only: & config_crystallite, & - crystallite_name, & - config_deallocate + crystallite_name use constitutive, only: & constitutive_initialFi, & constitutive_microstructure ! derived (shortcut) quantities of given state @@ -376,7 +375,7 @@ subroutine crystallite_init close(FILEUNIT) endif - call config_deallocate('material.config/crystallite') + deallocate(config_crystallite) !-------------------------------------------------------------------------------------------------- ! initialize diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 3565999a8..de195f18a 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -101,7 +101,6 @@ subroutine homogenization_init crystallite_maxSizePostResults #endif use config, only: & - config_deallocate, & material_configFile, & material_localFileExt, & config_homogenization, & @@ -375,7 +374,7 @@ subroutine homogenization_init close(FILEUNIT) endif mainProcess2 - call config_deallocate('material.config/homogenization') + deallocate(config_homogenization) !-------------------------------------------------------------------------------------------------- ! allocate and initialize global variables diff --git a/src/material.f90 b/src/material.f90 index 4c5a9ed74..73edc8281 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -360,8 +360,7 @@ subroutine material_init() homogenization_name, & microstructure_name, & phase_name, & - texture_name, & - config_deallocate + texture_name use mesh, only: & mesh_maxNips, & mesh_NcpElems, & @@ -469,7 +468,6 @@ subroutine material_init() endif debugOut call material_populateGrains - call config_deallocate('material.config/microstructure') allocate(phaseAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) allocate(phasememberAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) @@ -921,8 +919,7 @@ subroutine material_parseTexture IO_floatValue, & IO_stringValue use config, only: & - config_texture, & - config_deallocate + config_texture use math, only: & inRad, & math_sampleRandomOri, & @@ -1061,7 +1058,7 @@ subroutine material_parseTexture endif enddo - call config_deallocate('material.config/texture') + deallocate(config_texture) end subroutine material_parseTexture @@ -1429,6 +1426,7 @@ subroutine material_populateGrains deallocate(texture_transformation) deallocate(Nelems) deallocate(elemsOfHomogMicro) + deallocate(config_microstructure) end subroutine material_populateGrains From 037ab3d081f3389ac774e29a97c484d3cdf9bb5d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 13:10:59 +0200 Subject: [PATCH 152/208] getTag works now for tags with the same start and close tag needed for '/echo/'. Still suggest to rather use /echo\ --- src/IO.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 4a61f25c1..6777fd6c7 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -833,16 +833,16 @@ pure function IO_getTag(string,openChar,closeChar) character(len=*), intent(in) :: string !< string to check for tag character(len=len_trim(string)) :: IO_getTag - character(len=*), intent(in) :: openChar, & !< indicates beginning of tag - closeChar !< indicates end of tag + character, intent(in) :: openChar, & !< indicates beginning of tag + closeChar !< indicates end of tag character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces integer :: left,right ! no pInt IO_getTag = '' - left = scan(string,openChar) - right = scan(string,closeChar) + left = scan(string,openChar) + right = merge(scan(string,closeChar), scan(string(left:),closeChar),openChar /= closeChar) if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs IO_getTag = string(left+1:right-1) From 1b5623ad6cfa55d4c409bd97245bc15593c67c30 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 13:57:43 +0200 Subject: [PATCH 153/208] avoid out of bound access, removed unneeded stuff --- src/IO.f90 | 183 +++-------------------------------------------------- 1 file changed, 9 insertions(+), 174 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 6777fd6c7..0358785f6 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -36,10 +36,6 @@ module IO IO_hybridIA, & IO_isBlank, & IO_getTag, & - IO_countSections, & - IO_countTagInPart, & - IO_spotTagInPart, & - IO_globalTagInPart, & IO_stringPos, & IO_stringValue, & IO_fixedStringValue ,& @@ -837,12 +833,18 @@ pure function IO_getTag(string,openChar,closeChar) closeChar !< indicates end of tag character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces - integer :: left,right ! no pInt IO_getTag = '' - left = scan(string,openChar) - right = merge(scan(string,closeChar), scan(string(left:),closeChar),openChar /= closeChar) + + + if (openChar /= closeChar) then + left = scan(string,openChar) + right = scan(string,closeChar) + else + left = scan(string,openChar) + right = left + merge(scan(string(left+1:),openChar),0_pInt,len(string) > left) + endif if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs IO_getTag = string(left+1:right-1) @@ -850,173 +852,6 @@ pure function IO_getTag(string,openChar,closeChar) end function IO_getTag -!-------------------------------------------------------------------------------------------------- -!> @brief count number of [sections] in for given file handle -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countSections(fileUnit,part) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - character(len=*), intent(in) :: part !< part name in which sections are counted - - character(len=65536) :: line - - line = '' - IO_countSections = 0_pInt - rewind(fileUnit) - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part - line = IO_read(fileUnit) - enddo - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier - IO_countSections = IO_countSections + 1_pInt - enddo - -end function IO_countSections - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns array of tag counts within for at most N [sections] -!-------------------------------------------------------------------------------------------------- -function IO_countTagInPart(fileUnit,part,tag,Nsections) - - implicit none - integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for - integer(pInt), dimension(Nsections) :: IO_countTagInPart - integer(pInt), intent(in) :: fileUnit !< file handle - character(len=*),intent(in) :: part, & !< part in which tag is searched for - tag !< tag to search for - - - integer(pInt), dimension(Nsections) :: counter - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: section - character(len=65536) :: line - - line = '' - counter = 0_pInt - section = 0_pInt - - rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part - line = IO_read(fileUnit) - enddo - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier - if (section > 0) then - chunkPos = IO_stringPos(line) - if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match - counter(section) = counter(section) + 1_pInt - endif - enddo - - IO_countTagInPart = counter - -end function IO_countTagInPart - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns array of tag presence within for at most N [sections] -!-------------------------------------------------------------------------------------------------- -function IO_spotTagInPart(fileUnit,part,tag,Nsections) - - implicit none - integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for - logical, dimension(Nsections) :: IO_spotTagInPart - integer(pInt), intent(in) :: fileUnit !< file handle - character(len=*),intent(in) :: part, & !< part in which tag is searched for - tag !< tag to search for - - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: section - character(len=65536) :: line - - IO_spotTagInPart = .false. ! assume to nowhere spot tag - section = 0_pInt - line = '' - - rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part - line = IO_read(fileUnit) - enddo - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier - if (section > 0_pInt) then - chunkPos = IO_stringPos(line) - if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match - IO_spotTagInPart(section) = .true. - endif - enddo - - end function IO_spotTagInPart - - -!-------------------------------------------------------------------------------------------------- -!> @brief return logical whether tag is present within before any [sections] -!-------------------------------------------------------------------------------------------------- -logical function IO_globalTagInPart(fileUnit,part,tag) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - character(len=*),intent(in) :: part, & !< part in which tag is searched for - tag !< tag to search for - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line - - IO_globalTagInPart = .false. ! assume to nowhere spot tag - line ='' - - rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part - line = IO_read(fileUnit) - enddo - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - foundFirstSection: if (IO_getTag(line,'[',']') /= '') then - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundFirstSection - chunkPos = IO_stringPos(line) - match: if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) then - IO_globalTagInPart = .true. - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif match - enddo - -end function IO_globalTagInPart - - !-------------------------------------------------------------------------------------------------- !> @brief locates all space-separated chunks in given string and returns array containing number !! them and the left/right position to be used by IO_xxxVal From ab45818d51c60bf188be070deb67f2c5115e94c0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 14:30:51 +0200 Subject: [PATCH 154/208] seems to work now anyway, nicer code --- src/config.f90 | 65 ++++++++++++++++++------------------------ src/constitutive.f90 | 5 ++-- src/crystallite.f90 | 3 +- src/homogenization.f90 | 3 +- src/material.f90 | 6 ++-- 5 files changed, 38 insertions(+), 44 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index a22acbff9..959568d7b 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -47,7 +47,7 @@ module config type(tPartitionedStringList), public :: emptyList - type(tPartitionedStringList), public, allocatable, dimension(:) :: & + type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & config_phase, & config_microstructure, & config_homogenization, & @@ -82,9 +82,9 @@ module config MATERIAL_configFile = 'material.config', & !< generic name for material configuration file MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file - public :: & - config_init + config_init, & + config_deallocate contains @@ -137,7 +137,7 @@ subroutine config_init() fileContent = IO_recursiveRead('material.config') endif - do i=1, size(fileContent) + do i = 1_pInt, size(fileContent) line = trim(fileContent(i)) part = IO_lc(IO_getTag(line,'<','>')) select case (trim(part)) @@ -188,11 +188,7 @@ subroutine parseFile(line,sectionNames,part,& pStringLen use IO, only: & IO_error, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringValue, & - IO_stringPos + IO_getTag implicit none character(len=pStringLen), intent(out) :: line @@ -200,44 +196,38 @@ subroutine parseFile(line,sectionNames,part,& type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part character(len=pStringLen), dimension(:), intent(in) :: fileContent - character(len=64), allocatable, dimension(:) :: sectionNamesTemp ! Circumvent Gfortran bug - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: s,i - character(len=64) :: tag + integer(pInt), allocatable, dimension(:) :: partPosition + integer(pInt) :: i logical :: echo echo = .false. allocate(part(0)) - tag='' - allocate(sectionNamesTemp(0),source=tag) + allocate(partPosition(0)) - s = 0_pInt - do i=1, size(fileContent) + do i = 1_pInt, size(fileContent) line = trim(fileContent(i)) - if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit nextSection: if (IO_getTag(line,'[',']') /= '') then - s = s + 1_pInt - part = [part, emptyList] - tag = IO_getTag(line,'[',']') - sectionNamesTemp = [sectionNamesTemp,tag] + part = [part, emptyList] + partPosition = [partPosition, i] cycle endif nextSection - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key - inSection: if (s > 0_pInt) then - call part(s)%add(IO_lc(trim(line))) + inSection: if (size(part) > 0_pInt) then + call part(size(part))%add(trim(adjustl(line))) else inSection - echo = (trim(tag) == '/echo/') + if (trim(IO_getTag(line,'/','/')) == 'echo') echo = .true. endif inSection enddo - sectionNames = sectionNamesTemp + allocate(sectionNames(size(partPosition))) + do i = 1_pInt, size(partPosition) + sectionNames(i) = trim(adjustl(fileContent(partPosition(i)))) + enddo if (echo) then - do s = 1, size(sectionNames) - write(6,*) 'section',s, '"'//trim(sectionNames(i))//'"' - call part(s)%show() + do i = 1, size(sectionNames) + write(6,'(a)') 'section',i, '"'//trim(sectionNames(i))//'"' + call part(i)%show() end do end if @@ -252,7 +242,6 @@ subroutine config_deallocate(what) implicit none character(len=*), intent(in) :: what - integer(pInt) :: i select case(trim(what)) @@ -336,7 +325,7 @@ end subroutine show !-------------------------------------------------------------------------------------------------- -!> @brief cleans entire list +!> @brief empties list and frees associated memory !> @details explicit interface to reset list. Triggers final statement (and following chain reaction) !-------------------------------------------------------------------------------------------------- subroutine free(this) @@ -350,8 +339,8 @@ end subroutine free !-------------------------------------------------------------------------------------------------- -!> @brief cleans entire list -!> @details called when variable goes out of scope. Triggers chain reaction. +!> @brief empties list and frees associated memory +!> @details called when variable goes out of scope. Triggers chain reaction for list !-------------------------------------------------------------------------------------------------- recursive subroutine finalize(this) @@ -364,15 +353,15 @@ end subroutine finalize !-------------------------------------------------------------------------------------------------- -!> @brief cleans entire list -!> @details called when variable goes out of scope. Triggers chain reaction. +!> @brief cleans entire array of linke lists +!> @details called when variable goes out of scope. !-------------------------------------------------------------------------------------------------- subroutine finalizeArray(this) implicit none integer :: i type(tPartitionedStringList), intent(inout), dimension(:) :: this - type(tPartitionedStringList), pointer :: temp ! bug in Gfortran + type(tPartitionedStringList), pointer :: temp ! bug in Gfortran? do i=1, size(this) if (associated(this(i)%next)) then diff --git a/src/constitutive.f90 b/src/constitutive.f90 index f27edcc07..43207c65c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -65,7 +65,8 @@ subroutine constitutive_init() material_Nphase, & material_localFileExt, & phase_name, & - material_configFile + material_configFile, & + config_deallocate use material, only: & material_phase, & phase_plasticity, & @@ -192,7 +193,7 @@ subroutine constitutive_init() if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) close(FILEUNIT) - deallocate(config_phase) + call config_deallocate('material.config/phase') write(6,'(/,a)') ' <<<+- constitutive init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 6601fe29e..b9ae84a44 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -172,6 +172,7 @@ subroutine crystallite_init IO_error use material use config, only: & + config_deallocate, & config_crystallite, & crystallite_name use constitutive, only: & @@ -375,7 +376,7 @@ subroutine crystallite_init close(FILEUNIT) endif - deallocate(config_crystallite) + call config_deallocate('material.config/crystallite') !-------------------------------------------------------------------------------------------------- ! initialize diff --git a/src/homogenization.f90 b/src/homogenization.f90 index de195f18a..496514d3b 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -103,6 +103,7 @@ subroutine homogenization_init use config, only: & material_configFile, & material_localFileExt, & + config_deallocate, & config_homogenization, & homogenization_name use material @@ -374,7 +375,7 @@ subroutine homogenization_init close(FILEUNIT) endif mainProcess2 - deallocate(config_homogenization) + call config_deallocate('material.config/homogenization') !-------------------------------------------------------------------------------------------------- ! allocate and initialize global variables diff --git a/src/material.f90 b/src/material.f90 index 73edc8281..f578867f8 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -919,6 +919,7 @@ subroutine material_parseTexture IO_floatValue, & IO_stringValue use config, only: & + config_deallocate, & config_texture use math, only: & inRad, & @@ -1058,7 +1059,7 @@ subroutine material_parseTexture endif enddo - deallocate(config_texture) + call config_deallocate('material.config/texture') end subroutine material_parseTexture @@ -1090,6 +1091,7 @@ subroutine material_populateGrains use config, only: & config_homogenization, & config_microstructure, & + config_deallocate, & homogenization_name, & microstructure_name use IO, only: & @@ -1426,7 +1428,7 @@ subroutine material_populateGrains deallocate(texture_transformation) deallocate(Nelems) deallocate(elemsOfHomogMicro) - deallocate(config_microstructure) + call config_deallocate('material.config/microstructure') end subroutine material_populateGrains From a0cb6811ab371f1406fd59100104f6f23106f34b Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 22 Aug 2018 17:20:29 +0200 Subject: [PATCH 155/208] [skip ci] updated version information after successful test of v2.0.2-394-g51dbc6c4 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 0f2fd848d..25c6284d7 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-390-g7c683d4f +v2.0.2-394-g51dbc6c4 From 1a943df97e171ea6e11b19c4e8037cf8c552b58f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 17:52:00 +0200 Subject: [PATCH 156/208] small flaws --- src/DAMASK_interface.f90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index 8d146c014..02a1ad1d8 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -318,21 +318,20 @@ function rectifyPath(path) implicit none character(len=*) :: path - character(len=len_trim(path)) :: rectifyPath + character(len=1024) :: rectifyPath integer :: i,j,k,l ! no pInt !-------------------------------------------------------------------------------------------------- ! remove /./ from path - l = len_trim(path) - rectifyPath = path + rectifyPath = trim(path) + l = len_trim(rectifyPath) do i = l,3,-1 if (rectifyPath(i-2:i) == '/./') rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' enddo !-------------------------------------------------------------------------------------------------- ! remove // from path - l = len_trim(path) - rectifyPath = path + l = len_trim(rectifyPath) do i = l,2,-1 if (rectifyPath(i-1:i) == '//') rectifyPath(i-1:l) = rectifyPath(i:l)//' ' enddo From dc596e678942bf82389e3189400cfec4c6cfe319 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 18:09:17 +0200 Subject: [PATCH 157/208] zero termination does not work --- src/system_routines.f90 | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/src/system_routines.f90 b/src/system_routines.f90 index 662751067..bea777a3d 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -85,23 +85,22 @@ character(len=1024) function getCWD() C_NULL_CHAR implicit none - character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array + character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array integer(C_INT) :: stat integer :: i - call getCurrentWorkDir_C(strFixedLength,stat) + call getCurrentWorkDir_C(charArray,stat) if (stat /= 0_C_INT) then getCWD = 'Error occured when getting currend working directory' else getCWD = repeat('',len(getCWD)) - do i=1,1024 ! copy array components until Null string is found - if (strFixedLength(i) /= C_NULL_CHAR) then - getCWD(i:i)=strFixedLength(i) + arrayToString: do i=1,len(getCWD) + if (charArray(i) /= C_NULL_CHAR) then + getCWD(i:i)=charArray(i) else - getCWD(i:i)=char(0) exit endif - enddo + enddo arrayToString endif end function getCWD @@ -117,22 +116,22 @@ character(len=1024) function getHostName() C_NULL_CHAR implicit none - character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array + character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array integer(C_INT) :: stat integer :: i - call getHostName_C(strFixedLength,stat) + call getHostName_C(charArray,stat) if (stat /= 0_C_INT) then getHostName = 'Error occured when getting host name' else getHostName = repeat('',len(getHostName)) - do i=1,1024 ! copy array components until Null string is found - if (strFixedLength(i) /= C_NULL_CHAR) then - getHostName(i:i)=strFixedLength(i) + arrayToString: do i=1,len(getHostName) + if (charArray(i) /= C_NULL_CHAR) then + getHostName(i:i)=charArray(i) else exit endif - enddo + enddo arrayToString endif end function getHostName From a3b472a74d114c2c4fca3be4437f113257f87dc9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 18:13:57 +0200 Subject: [PATCH 158/208] test also working for 38-branch appending extension automatically is not really KISS --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index ce48785dc..5002c2082 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit ce48785dcc5c9cae28cd35d45b612223c37c73b0 +Subproject commit 5002c20826d6de6b007060add02df280f62da7af From 51b4ef319a0033fdd4bdc1a14e52b318456ad4d3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 20:12:16 +0200 Subject: [PATCH 159/208] HDF5 was not compiled due to missing dependency --- src/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index be01bd4ee..3689d15c5 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -36,7 +36,7 @@ add_dependencies(HDF5_UTILITIES IO) list(APPEND OBJECTFILES $) add_library(NUMERICS OBJECT "numerics.f90") -add_dependencies(NUMERICS IO) +add_dependencies(NUMERICS HDF5_UTILITIES) list(APPEND OBJECTFILES $) add_library(DEBUG OBJECT "debug.f90") From 8c5f3d4e07b2eada54a4e6a254e227c30a2fa6ab Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 22:52:12 +0200 Subject: [PATCH 160/208] only needed once --- src/config.f90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 959568d7b..f7c8bfcdc 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -45,8 +45,6 @@ module config end type tPartitionedStringList - type(tPartitionedStringList), public :: emptyList - type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & config_phase, & config_microstructure, & @@ -197,6 +195,7 @@ subroutine parseFile(line,sectionNames,part,& character(len=pStringLen), dimension(:), intent(in) :: fileContent integer(pInt), allocatable, dimension(:) :: partPosition + type(tPartitionedStringList) :: emptyList integer(pInt) :: i logical :: echo @@ -364,11 +363,11 @@ subroutine finalizeArray(this) type(tPartitionedStringList), pointer :: temp ! bug in Gfortran? do i=1, size(this) - if (associated(this(i)%next)) then + !if (associated(this(i)%next)) then temp => this(i)%next !deallocate(this(i)) !internal compiler error: in gfc_build_final_call, at fortran/trans.c:975 deallocate(temp) - endif + !endif enddo end subroutine finalizeArray From 271b9ba76bcd5135b10da4748bfe96b1cd60f7f0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 22 Aug 2018 23:28:47 +0200 Subject: [PATCH 161/208] intersting note ... --- src/prec.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/prec.f90 b/src/prec.f90 index 959ee77ba..f6c0fd543 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -7,6 +7,7 @@ !> @brief setting precision for real and int type !-------------------------------------------------------------------------------------------------- module prec +! ToDo: use, intrinsic :: iso_fortran_env, only : I8 => int64, WP => real64 implicit none private #if (FLOAT==8) From 7ecb7689f166f6877f622e4d10b4f09f108bb68f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 23 Aug 2018 00:13:57 +0200 Subject: [PATCH 162/208] Intel compiler failed with SIGSEV derived types, pointers, finalize .... altogether seems to bring both Compilers to their limits. I cannot see what was wrong before, but now it works and might be a little faster --- src/config.f90 | 38 ++++++++++++++++++-------------------- 1 file changed, 18 insertions(+), 20 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index f7c8bfcdc..837818756 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -194,41 +194,39 @@ subroutine parseFile(line,sectionNames,part,& type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part character(len=pStringLen), dimension(:), intent(in) :: fileContent - integer(pInt), allocatable, dimension(:) :: partPosition - type(tPartitionedStringList) :: emptyList - integer(pInt) :: i + integer(pInt), allocatable, dimension(:) :: partPosition ! position of [] tags + last line in section + integer(pInt) :: i, j logical :: echo echo = .false. - allocate(part(0)) allocate(partPosition(0)) - + do i = 1_pInt, size(fileContent) line = trim(fileContent(i)) if (IO_getTag(line,'<','>') /= '') exit nextSection: if (IO_getTag(line,'[',']') /= '') then - part = [part, emptyList] partPosition = [partPosition, i] cycle endif nextSection - inSection: if (size(part) > 0_pInt) then - call part(size(part))%add(trim(adjustl(line))) - else inSection - if (trim(IO_getTag(line,'/','/')) == 'echo') echo = .true. - endif inSection + if (size(partPosition) < 1_pInt) & + echo = (trim(IO_getTag(line,'/','/')) == 'echo') .or. echo enddo allocate(sectionNames(size(partPosition))) - do i = 1_pInt, size(partPosition) - sectionNames(i) = trim(adjustl(fileContent(partPosition(i)))) - enddo + allocate(part(size(partPosition))) - if (echo) then - do i = 1, size(sectionNames) - write(6,'(a)') 'section',i, '"'//trim(sectionNames(i))//'"' + partPosition = [partPosition, i] ! needed when actually storing content + + do i = 1_pInt, size(partPosition) -1_pInt + sectionNames(i) = trim(adjustl(fileContent(partPosition(i)))) + do j = partPosition(i) + 1_pInt, partPosition(i+1) -1_pInt + call part(i)%add(trim(adjustl(fileContent(j)))) + enddo + if (echo) then + write(6,*) 'section',i, '"'//trim(sectionNames(i))//'"' call part(i)%show() - end do - end if + endif + enddo end subroutine parseFile @@ -316,7 +314,7 @@ subroutine show(this) item => this do while (associated(item%next)) - write(6,'(a)') trim(item%string%val) + write(6,'(a)') ' '//trim(item%string%val) item => item%next end do From 8cf6dea81899ea71065420f645cc8e575119f677 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 23 Aug 2018 06:56:13 +0200 Subject: [PATCH 163/208] one more test compatible with 38-.. branch --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 5002c2082..486a318b7 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 5002c20826d6de6b007060add02df280f62da7af +Subproject commit 486a318b7ce76fd107fe16dc9876ad36929d14d4 From 4867dfa20c7133445550f03bbc3f6a3754e65410 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 23 Aug 2018 08:24:47 +0200 Subject: [PATCH 164/208] test working for 32-.. branch --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 486a318b7..55551f34c 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 486a318b7ce76fd107fe16dc9876ad36929d14d4 +Subproject commit 55551f34c08c4e95feedef35646971116464abc3 From acd956ea6225a557a64338c0e9f07b655e592ac7 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 23 Aug 2018 13:38:02 +0200 Subject: [PATCH 165/208] [skip ci] updated version information after successful test of v2.0.2-401-ga3b472a7 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 25c6284d7..5a1edffc9 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-394-g51dbc6c4 +v2.0.2-401-ga3b472a7 From fa72998afca08c5cf07d12d657ffc8191f0a7d89 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 24 Aug 2018 06:48:43 +0200 Subject: [PATCH 166/208] [skip ci] updated version information after successful test of v2.0.2-402-g8cf6dea8 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 25c6284d7..b1aa06829 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-394-g51dbc6c4 +v2.0.2-402-g8cf6dea8 From ac011684dd176584fb7129a0b39281b64f0593df Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 24 Aug 2018 10:34:04 +0200 Subject: [PATCH 167/208] 3 tests that do not append *.load to the load case file automatic appending will not work for combined spectral and FEM interface as default extension is *.geom for spectral but *.msh for FEM. --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 55551f34c..dfd67ea44 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 55551f34c08c4e95feedef35646971116464abc3 +Subproject commit dfd67ea44ba88ee1e0a33266a3986c64137908cf From 2c8fd880c032ac75441044c0db924da0bf6f9d59 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 24 Aug 2018 13:39:06 +0200 Subject: [PATCH 168/208] [skip ci] updated version information after successful test of v2.0.2-403-g4867dfa2 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 25c6284d7..0f9d611c0 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-394-g51dbc6c4 +v2.0.2-403-g4867dfa2 From 22a232ad0860e6ec19a8c7af8b96e6877532bdc9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 15:50:43 +0200 Subject: [PATCH 169/208] bug: memory access out of bounds introduced when moderninzing reading in of parameters --- src/lattice.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index ca1cd597a..550b4c5c9 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1278,7 +1278,7 @@ subroutine lattice_init integer(pInt) :: Nphases character(len=65536) :: & tag = '' - integer(pInt) :: section = 0_pInt,i,p + integer(pInt) :: i,p real(pReal), dimension(:), allocatable :: & temp, & CoverA, & !< c/a ratio for low symmetry type lattice @@ -1388,9 +1388,9 @@ subroutine lattice_init tag = config_phase(p)%getString('trans_lattice_structure',defaultVal=tag) select case(trim(tag)) case('bcc') - trans_lattice_structure(section) = LATTICE_bcc_ID + trans_lattice_structure(p) = LATTICE_bcc_ID case('hex','hexagonal') - trans_lattice_structure(section) = LATTICE_hex_ID + trans_lattice_structure(p) = LATTICE_hex_ID end select lattice_C66(1,1,p) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) From a4638881569e17945d6c0bbc35ab383a5a10f3a9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 15:51:28 +0200 Subject: [PATCH 170/208] test in PRIVATE improved --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index dfd67ea44..81fd7109f 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit dfd67ea44ba88ee1e0a33266a3986c64137908cf +Subproject commit 81fd7109fea8456b8eecaaef0eec041edcce7792 From 7af7e45b6da5c3254e6a404912f05f9ada33591b Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 26 Aug 2018 05:02:31 +0200 Subject: [PATCH 171/208] [skip ci] updated version information after successful test of v2.0.2-409-gac011684 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 5a1edffc9..390024a1f 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-401-ga3b472a7 +v2.0.2-409-gac011684 From 241b2ade8b015ecc0d6debd97c9fcf015e6aeedf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Aug 2018 11:40:38 +0200 Subject: [PATCH 172/208] more portable way to define PI https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/490432 and compiler will not complain about truncation --- PRIVATE | 2 +- src/math.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index 81fd7109f..a764ade04 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 81fd7109fea8456b8eecaaef0eec041edcce7792 +Subproject commit a764ade044735df35fac93a5204446291ee29abc diff --git a/src/math.f90 b/src/math.f90 index 955be4457..4179d6edc 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -12,7 +12,7 @@ module math implicit none private - real(pReal), parameter, public :: PI = 3.141592653589793_pReal !< ratio of a circle's circumference to its diameter + real(pReal), parameter, public :: PI = acos(-1.0_pReal) !< ratio of a circle's circumference to its diameter real(pReal), parameter, public :: INDEG = 180.0_pReal/PI !< conversion from radian into degree real(pReal), parameter, public :: INRAD = PI/180.0_pReal !< conversion from degree into radian complex(pReal), parameter, public :: TWOPIIMG = (0.0_pReal,2.0_pReal)*(PI,0.0_pReal) !< Re(0.0), Im(2xPi) From a5f139b786b33c7ddac12818214b7d9868ff279f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Aug 2018 11:53:18 +0200 Subject: [PATCH 173/208] unused variables --- src/plastic_isotropic.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 264fe7e18..d65fe583f 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -109,11 +109,9 @@ use IO type(tParameters), pointer :: prm integer(pInt) :: & - o, & phase, & instance, & maxNinstance, & - mySize, & sizeDotState, & sizeState, & sizeDeltaState @@ -136,7 +134,6 @@ use IO plastic_isotropic_output = '' allocate(plastic_isotropic_Noutput(maxNinstance), source=0_pInt) -! inernal variable allocate(param(maxNinstance)) ! one container of parameters per instance allocate(state(maxNinstance)) ! internal state aliases allocate(dotState(maxNinstance)) From c6c853419b3fdddbe3b3925eb33768251ba25ccd Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 26 Aug 2018 23:28:33 +0200 Subject: [PATCH 174/208] [skip ci] updated version information after successful test of v2.0.2-414-ga4638881 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 5a1edffc9..adc0ff999 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-401-ga3b472a7 +v2.0.2-414-ga4638881 From d765cf285b32a3b36d0aa1920682e12cc2e36140 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 27 Aug 2018 08:11:39 +0200 Subject: [PATCH 175/208] [skip ci] updated version information after successful test of v2.0.2-442-gb11666ef --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 390024a1f..21a7c7c31 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-409-gac011684 +v2.0.2-442-gb11666ef From 6ed68c91349ba89ba47f5793e236684a73350c65 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 28 Aug 2018 05:26:48 +0200 Subject: [PATCH 176/208] [skip ci] updated version information after successful test of v2.0.2-474-g38fd517c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 21a7c7c31..fd2858d51 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-442-gb11666ef +v2.0.2-474-g38fd517c From 94695f773ef495929a8ae961e9bfc2d1907cc932 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 Aug 2018 07:47:05 +0200 Subject: [PATCH 177/208] more verbose and works for arbitrary precision --- src/math.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 4179d6edc..440ee5303 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -36,13 +36,13 @@ module math real(pReal), dimension(6), parameter, private :: & nrmMandel = [& - 1.0_pReal, 1.0_pReal, 1.0_pReal,& - 1.414213562373095_pReal, 1.414213562373095_pReal, 1.414213562373095_pReal ] !< weighting for Mandel notation (forward) + 1.0_pReal, 1.0_pReal, 1.0_pReal, & + sqrt(2.0_pReal), sqrt(2.0_pReal), sqrt(2.0_pReal) ] !< weighting for Mandel notation (forward) real(pReal), dimension(6), parameter , public :: & invnrmMandel = [& - 1.0_pReal, 1.0_pReal, 1.0_pReal,& - 0.7071067811865476_pReal, 0.7071067811865476_pReal, 0.7071067811865476_pReal ] !< weighting for Mandel notation (backward) + 1.0_pReal, 1.0_pReal, 1.0_pReal, & + 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal) ] !< weighting for Mandel notation (backward) integer(pInt), dimension (2,6), parameter, private :: & mapVoigt = reshape([& From 42f8b0a06378bdd7ffe8b3a91961b55e6842166c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 24 Aug 2018 12:42:30 +0200 Subject: [PATCH 178/208] labels of slip and twin systems for more self-explanatory output --- src/lattice.f90 | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/src/lattice.f90 b/src/lattice.f90 index 550b4c5c9..ffe1c239d 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -111,6 +111,9 @@ module lattice -1,-1, 0, -1, 1,-1 & ! D6 ],pReal),[ 3_pInt + 3_pInt,LATTICE_fcc_Nslip]) !< Slip system <110>{111} directions. Sorted according to Eisenlohr & Hantcherli + character(len=*), dimension(1), parameter, public :: LATTICE_FCC_SLIPFAMILY_NAME = & + ['<0 1 -1>{1 1 1}'] + real(pReal), dimension(3+3,LATTICE_fcc_Ntwin), parameter, private :: & LATTICE_fcc_systemTwin = reshape(real( [& -2, 1, 1, 1, 1, 1, & @@ -127,6 +130,9 @@ module lattice -1, 1, 2, -1, 1,-1 & ],pReal),[ 3_pInt + 3_pInt,LATTICE_fcc_Ntwin]) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli + character(len=*), dimension(1), parameter, public :: LATTICE_FCC_TWINFAMILY_NAME = & + ['<-2 1 1>{1 1 1}'] + real(pReal), dimension(3+3,LATTICE_fcc_Ntrans), parameter, private :: & LATTICE_fccTohex_systemTrans = reshape(real( [& -2, 1, 1, 1, 1, 1, & @@ -433,6 +439,10 @@ module lattice ! 1,-1, 1, 3, 2,-1 & ],pReal),[ 3_pInt + 3_pInt ,LATTICE_bcc_Nslip]) + character(len=*), dimension(2), parameter, public :: LATTICE_BCC_SLIPFAMILY_NAME = & + ['<1 -1 1>{0 1 1}', & + '<1 -1 1>{2 1 1}'] + real(pReal), dimension(3+3,LATTICE_bcc_Ntwin), parameter, private :: & LATTICE_bcc_systemTwin = reshape(real([& ! Twin system <111>{112} @@ -450,6 +460,9 @@ module lattice 1, 1, 1, 1, 1,-2 & ],pReal),[ 3_pInt + 3_pInt,LATTICE_bcc_Ntwin]) + character(len=*), dimension(1), parameter, public :: LATTICE_BCC_TWINFAMILY_NAME = & + ['<1 1 1>{2 1 1}'] + real(pReal), dimension(LATTICE_bcc_Ntwin), parameter, private :: & LATTICE_bcc_shearTwin = 0.5_pReal*sqrt(2.0_pReal) @@ -618,6 +631,14 @@ module lattice 1, 1, -2, 3, -1, -1, 2, 2 & ],pReal),[ 4_pInt + 4_pInt,LATTICE_hex_Nslip]) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr + character(len=*), dimension(6), parameter, public :: LATTICE_HEX_SLIPFAMILY_NAME = & + ['<1 1 . 1>{0 0 . 1} ', & + '<1 1 . 1>{1 0 . 0} ', & + '<1 0 . 0>{1 1 . 0} ', & + '<1 1 . 0>{-1 1 . 1} ', & + '<1 1 . 3>{-1 0 . 1} ', & + '<1 1 . 3>{-1 -1 . 2}'] + real(pReal), dimension(4+4,LATTICE_hex_Ntwin), parameter, private :: & LATTICE_hex_systemTwin = reshape(real([& ! Compression or Tension =f(twinning shear=f(c/a)) for each metal ! (according to Yoo 1981) @@ -650,6 +671,12 @@ module lattice 1, 1, -2, -3, 1, 1, -2, 2 & ],pReal),[ 4_pInt + 4_pInt ,LATTICE_hex_Ntwin]) !< twin systems for hex, order follows Prof. Tom Bieler's scheme; but numbering in data was restarted from 1 + character(len=*), dimension(4), parameter, public :: LATTICE_HEX_TWINFAMILY_NAME = & + ['<-1 0 . 1>{1 0 . 2} ', & + '<1 1 . 6>{-1 -1 . 1}', & + '<1 0 . -2>{1 0 . 1} ', & + '<1 1 . -3>{1 1 . 2} '] + integer(pInt), dimension(LATTICE_hex_Ntwin), parameter, private :: & LATTICE_hex_shearTwin = reshape(int( [& ! indicator to formula further below 1, & ! <-10.1>{10.2} @@ -926,6 +953,21 @@ module lattice 1, 1, 1, 1,-2, 1 & ],pReal),[ 3_pInt + 3_pInt,LATTICE_bct_Nslip]) !< slip systems for bct sorted by Bieler + character(len=*), dimension(13), parameter, public :: LATTICE_BCT_SLIPFAMILY_NAME = & + ['{1 0 0)<0 0 1] ', & + '{1 1 0)<0 0 1] ', & + '{1 0 0)<0 1 0] ', & + '{1 1 0)<1 -1 1]', & + '{1 1 0)<1 -1 0]', & + '{1 0 0)<0 1 1] ', & + '{0 0 1)<0 1 0] ', & + '{0 0 1)<1 1 0] ', & + '{0 1 1)<0 1 -1]', & + '{0 1 1)<1 -1 1]', & + '{0 1 1)<1 0 0] ', & + '{2 1 1)<0 1 -1]', & + '{2 1 1)<-1 1 1]'] + integer(pInt), dimension(LATTICE_bct_Nslip,LATTICE_bct_Nslip), parameter, public :: & LATTICE_bct_interactionSlipSlip = reshape(int( [& 1, 2, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & From 06e71563510cb12fc0e09cad559cf05e449ac5d6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 Aug 2018 12:41:21 +0200 Subject: [PATCH 179/208] did not work for values <0 --- src/IO.f90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 0358785f6..8e1b9e80f 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -1363,12 +1363,16 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) pure function IO_intOut(intToPrint) implicit none - character(len=19) :: N_Digits ! maximum digits for 64 bit integer - character(len=40) :: IO_intOut integer(pInt), intent(in) :: intToPrint + character(len=41) :: IO_intOut + integer(pInt) :: N_digits + character(len=19) :: width ! maximum digits for 64 bit integer + character(len=20) :: min_width ! longer for negative values - write(N_Digits, '(I19.19)') 1_pInt + int(log10(real(intToPrint)),pInt) - IO_intOut = 'I'//trim(N_Digits)//'.'//trim(N_Digits) + N_digits = 1_pInt + int(log10(real(max(abs(intToPrint),1_pInt))),pInt) + write(width, '(I19.19)') N_digits + write(min_width, '(I20.20)') N_digits + merge(1_pInt,0_pInt,intToPrint < 0_pInt) + IO_intOut = 'I'//trim(min_width)//'.'//trim(width) end function IO_intOut From 8e9e9ca7526e9b682ba230920ea8a97ce3163725 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 28 Aug 2018 13:19:47 +0200 Subject: [PATCH 180/208] [skip ci] updated version information after successful test of v2.0.2-476-g94695f77 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index fd2858d51..fa3390c07 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-474-g38fd517c +v2.0.2-476-g94695f77 From e643752180aa0bc3af2ad1e6c8a2a5a1b0affe75 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 28 Aug 2018 23:13:17 +0200 Subject: [PATCH 181/208] [skip ci] updated version information after successful test of v2.0.2-478-g06e71563 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index fd2858d51..abe364a39 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-474-g38fd517c +v2.0.2-478-g06e71563 From 680c9e11d4403fb8db151d320284ad5bbe989065 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 29 Aug 2018 08:26:28 +0200 Subject: [PATCH 182/208] segmentation fault in cause of empty list --- src/config.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 837818756..d028eb897 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -351,7 +351,7 @@ end subroutine finalize !-------------------------------------------------------------------------------------------------- !> @brief cleans entire array of linke lists -!> @details called when variable goes out of scope. +!> @details called when variable goes out of scope and deallocates the list at each array entry !-------------------------------------------------------------------------------------------------- subroutine finalizeArray(this) @@ -361,11 +361,11 @@ subroutine finalizeArray(this) type(tPartitionedStringList), pointer :: temp ! bug in Gfortran? do i=1, size(this) - !if (associated(this(i)%next)) then + if (associated(this(i)%next)) then temp => this(i)%next !deallocate(this(i)) !internal compiler error: in gfc_build_final_call, at fortran/trans.c:975 deallocate(temp) - !endif + endif enddo end subroutine finalizeArray From 8fd3ac639668f6fb1f37e1d98dd5e8b103bc27e1 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 29 Aug 2018 13:23:54 +0200 Subject: [PATCH 183/208] [skip ci] updated version information after successful test of v2.0.2-485-gf2acc148 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index fa3390c07..3caf58c39 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-476-g94695f77 +v2.0.2-485-gf2acc148 From cb6b876769cc25ccd728675a87bed81fc28ded48 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 30 Aug 2018 00:58:01 +0200 Subject: [PATCH 184/208] need test for non-schmid --- PRIVATE | 2 +- examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.config | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index a764ade04..fa02113fa 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit a764ade044735df35fac93a5204446291ee29abc +Subproject commit fa02113fa7a0af3376648e4320318ec337fe79aa diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.config b/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.config index 6e005f251..c86d516a9 100644 --- a/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.config +++ b/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.config @@ -18,5 +18,5 @@ tau0_slip 405.8e6 456.7e6 # per family tausat_slip 872.9e6 971.2e6 # per family h0_slipslip 563.0e9 interaction_slipslip 1 1 1.4 1.4 1.4 1.4 -w0_slip 2.0 +a_slip 2.0 (output) totalshear From bb57e7b4983fbfd91f5e3eafdca36402fc245500 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 30 Aug 2018 04:43:22 +0200 Subject: [PATCH 185/208] [skip ci] updated version information after successful test of v2.0.2-488-ge0cecd4c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 3caf58c39..01392f6fe 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-485-gf2acc148 +v2.0.2-488-ge0cecd4c From 29e55d20fb2f2f55377cdc50a76b0ef29bbd3c7e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 30 Aug 2018 09:42:45 +0200 Subject: [PATCH 186/208] message better to understand and giving error instead of SIGSEGV --- src/IO.f90 | 4 +++- src/config.f90 | 24 +++++++++++++----------- 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 8e1b9e80f..c97dcfa9c 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -1477,6 +1477,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'illegal texture transformation specified' case (160_pInt) msg = 'no entries in config part' + case (161_pInt) + msg = 'config part found twice' case (165_pInt) msg = 'homogenization configuration' case (170_pInt) @@ -1574,7 +1576,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) case (845_pInt) msg = 'incomplete information in spectral mesh header' case (846_pInt) - msg = 'not a rotation defined for loadcase rotation' + msg = 'rotation for load case rotation ill-defined (R:RT != I)' case (847_pInt) msg = 'update of gamma operator not possible when pre-calculated' case (880_pInt) diff --git a/src/config.f90 b/src/config.f90 index d028eb897..4d5a76432 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -141,23 +141,23 @@ subroutine config_init() select case (trim(part)) case (trim(material_partPhase)) - call parseFile(line,phase_name,config_phase,fileContent(i+1:)) + call parseFile(phase_name,config_phase,line,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) case (trim(material_partMicrostructure)) - call parseFile(line,microstructure_name,config_microstructure,fileContent(i+1:)) + call parseFile(microstructure_name,config_microstructure,line,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) case (trim(material_partCrystallite)) - call parseFile(line,crystallite_name,config_crystallite,fileContent(i+1:)) + call parseFile(crystallite_name,config_crystallite,line,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) case (trim(material_partHomogenization)) - call parseFile(line,homogenization_name,config_homogenization,fileContent(i+1:)) + call parseFile(homogenization_name,config_homogenization,line,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) case (trim(material_partTexture)) - call parseFile(line,texture_name,config_texture,fileContent(i+1:)) + call parseFile(texture_name,config_texture,line,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) end select @@ -180,7 +180,7 @@ end subroutine config_init !-------------------------------------------------------------------------------------------------- !> @brief parses the material.config file !-------------------------------------------------------------------------------------------------- -subroutine parseFile(line,sectionNames,part,& +subroutine parseFile(sectionNames,part,line, & fileContent) use prec, only: & pStringLen @@ -189,16 +189,18 @@ subroutine parseFile(line,sectionNames,part,& IO_getTag implicit none - character(len=pStringLen), intent(out) :: line - character(len=64), allocatable, dimension(:), intent(out) :: sectionNames - type(tPartitionedStringList), allocatable, dimension(:), intent(out) :: part - character(len=pStringLen), dimension(:), intent(in) :: fileContent + character(len=64), allocatable, dimension(:), intent(out) :: sectionNames + type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part + character(len=pStringLen), intent(inout) :: line + character(len=pStringLen), dimension(:), intent(in) :: fileContent - integer(pInt), allocatable, dimension(:) :: partPosition ! position of [] tags + last line in section + integer(pInt), allocatable, dimension(:) :: partPosition ! position of [] tags + last line in section integer(pInt) :: i, j logical :: echo echo = .false. + + if (allocated(part)) call IO_error(161_pInt,ext_msg=trim(line)) allocate(partPosition(0)) do i = 1_pInt, size(fileContent) From 9a90eae3bc0cc42a67ec582387a3770941293b8d Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 31 Aug 2018 07:03:06 +0200 Subject: [PATCH 187/208] [skip ci] updated version information after successful test of v2.0.2-490-g29e55d20 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 01392f6fe..c1e114a98 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-488-ge0cecd4c +v2.0.2-490-g29e55d20 From d18d74ae312be8ff2df38934c2e8c570a2238fe2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 31 Aug 2018 08:20:23 +0200 Subject: [PATCH 188/208] mechanics solver type is set only once as all mech routines have the same interface, this leaner syntax can be used --- src/DAMASK_spectral.f90 | 78 +++++++++++++++++++---------------------- 1 file changed, 36 insertions(+), 42 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 7f968a7f5..72db08564 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -143,6 +143,12 @@ program DAMASK_spectral integer(pInt), parameter :: maxRealOut = maxByteOut/pReal integer(pLongInt), dimension(2) :: outputIndex integer :: ierr + procedure(basic_init), pointer :: & + mech_init + procedure(basic_forward), pointer :: & + mech_forward + procedure(basic_solution), pointer :: & + mech_solution external :: & quit @@ -163,6 +169,26 @@ program DAMASK_spectral if (any(damage_type == DAMAGE_nonlocal_ID )) nActiveFields = nActiveFields + 1 allocate(solres(nActiveFields)) +!-------------------------------------------------------------------------------------------------- +! assign mechanics solver depending on selected type + select case (spectral_solver) + case (DAMASK_spectral_SolverBasic_label) + mech_init => basic_init + mech_forward => basic_forward + mech_solution => basic_solution + + case (DAMASK_spectral_SolverPolarisation_label) + if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & + call IO_warning(42_pInt, ext_msg='debug Divergence') + mech_init => polarisation_init + mech_forward => polarisation_forward + mech_solution => polarisation_solution + + case default + call IO_error(error_ID = 891_pInt, ext_msg = trim(spectral_solver)) + + end select + !-------------------------------------------------------------------------------------------------- ! reading basic information from load case file and allocate data structure containing load cases call IO_open_file(FILEUNIT,trim(loadCaseFile)) @@ -189,7 +215,7 @@ program DAMASK_spectral allocate (loadCases(N_n)) ! array of load cases loadCases%stress%myType='stress' - do i = 1, size(loadCases) + do i = 1, size(loadCases) allocate(loadCases(i)%ID(nActiveFields)) field = 1 loadCases(i)%ID(field) = FIELD_MECH_ID ! mechanical active by default @@ -355,25 +381,13 @@ program DAMASK_spectral do field = 1, nActiveFields select case (loadCases(1)%ID(field)) case(FIELD_MECH_ID) - select case (spectral_solver) - case (DAMASK_spectral_SolverBasic_label) - call basic_init - - case (DAMASK_spectral_SolverPolarisation_label) - if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & - call IO_warning(42_pInt, ext_msg='debug Divergence') - call Polarisation_init - - case default - call IO_error(error_ID = 891_pInt, ext_msg = trim(spectral_solver)) - - end select + call mech_init case(FIELD_THERMAL_ID) call spectral_thermal_init case(FIELD_DAMAGE_ID) - call spectral_damage_init() + call spectral_damage_init end select enddo @@ -512,24 +526,14 @@ program DAMASK_spectral do field = 1, nActiveFields select case(loadCases(currentLoadCase)%ID(field)) case(FIELD_MECH_ID) - select case (spectral_solver) - case (DAMASK_spectral_SolverBasic_label) - call Basic_forward (& + call mech_forward (& guess,timeinc,timeIncOld,remainingLoadCaseTime, & deformation_BC = loadCases(currentLoadCase)%deformation, & stress_BC = loadCases(currentLoadCase)%stress, & rotation_BC = loadCases(currentLoadCase)%rotation) - case (DAMASK_spectral_SolverPolarisation_label) - call Polarisation_forward (& - guess,timeinc,timeIncOld,remainingLoadCaseTime, & - deformation_BC = loadCases(currentLoadCase)%deformation, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) - end select - - case(FIELD_THERMAL_ID); call spectral_thermal_forward() - case(FIELD_DAMAGE_ID); call spectral_damage_forward() + case(FIELD_THERMAL_ID); call spectral_thermal_forward() + case(FIELD_DAMAGE_ID); call spectral_damage_forward() end select enddo @@ -541,20 +545,10 @@ program DAMASK_spectral do field = 1, nActiveFields select case(loadCases(currentLoadCase)%ID(field)) case(FIELD_MECH_ID) - select case (spectral_solver) - case (DAMASK_spectral_SolverBasic_label) - solres(field) = Basic_solution (& - incInfo,timeinc,timeIncOld, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) - - case (DAMASK_spectral_SolverPolarisation_label) - solres(field) = Polarisation_solution (& - incInfo,timeinc,timeIncOld, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) - - end select + solres(field) = mech_solution (& + incInfo,timeinc,timeIncOld, & + stress_BC = loadCases(currentLoadCase)%stress, & + rotation_BC = loadCases(currentLoadCase)%rotation) case(FIELD_THERMAL_ID) solres(field) = spectral_thermal_solution(timeinc,timeIncOld,remainingLoadCaseTime) From b24ebb8a5b9b6956811e5888baf6ec6f87a20159 Mon Sep 17 00:00:00 2001 From: Franz Roters Date: Fri, 31 Aug 2018 08:52:21 +0200 Subject: [PATCH 189/208] not needed anymore as Marc always compiles with OpenMP adopted installation script and documentation accordingly --- .../2016/Marc_tools/comp_damask | 52 - .../2016/Marc_tools/comp_damask_h | 52 - .../2016/Marc_tools/comp_damask_l | 52 - .../2016/Marc_tools/run_damask | 4112 ---------------- .../2016/Marc_tools/run_damask_h | 4112 ---------------- .../2016/Marc_tools/run_damask_l | 4112 ---------------- .../mods_MarcMentat/2016/Mentat_bin/kill7 | 8 - .../mods_MarcMentat/2016/Mentat_bin/kill8 | 8 - .../mods_MarcMentat/2016/Mentat_bin/kill9 | 8 - .../mods_MarcMentat/2016/Mentat_bin/submit7 | 187 - .../mods_MarcMentat/2016/Mentat_bin/submit8 | 187 - .../mods_MarcMentat/2016/Mentat_bin/submit9 | 187 - .../2017/Marc_tools/comp_damask | 52 - .../2017/Marc_tools/comp_damask_h | 52 - .../2017/Marc_tools/comp_damask_l | 52 - .../2017/Marc_tools/run_damask | 4122 ----------------- .../2017/Marc_tools/run_damask_h | 4122 ----------------- .../2017/Marc_tools/run_damask_l | 4122 ----------------- .../mods_MarcMentat/2017/Mentat_bin/kill7 | 8 - .../mods_MarcMentat/2017/Mentat_bin/kill8 | 8 - .../mods_MarcMentat/2017/Mentat_bin/kill9 | 8 - .../mods_MarcMentat/2017/Mentat_bin/submit7 | 187 - .../mods_MarcMentat/2017/Mentat_bin/submit8 | 187 - .../mods_MarcMentat/2017/Mentat_bin/submit9 | 187 - .../apply_DAMASK_modifications.sh | 25 +- installation/mods_MarcMentat/installation.txt | 12 - 26 files changed, 5 insertions(+), 26216 deletions(-) delete mode 100644 installation/mods_MarcMentat/2016/Marc_tools/comp_damask delete mode 100644 installation/mods_MarcMentat/2016/Marc_tools/comp_damask_h delete mode 100644 installation/mods_MarcMentat/2016/Marc_tools/comp_damask_l delete mode 100644 installation/mods_MarcMentat/2016/Marc_tools/run_damask delete mode 100644 installation/mods_MarcMentat/2016/Marc_tools/run_damask_h delete mode 100644 installation/mods_MarcMentat/2016/Marc_tools/run_damask_l delete mode 100644 installation/mods_MarcMentat/2016/Mentat_bin/kill7 delete mode 100644 installation/mods_MarcMentat/2016/Mentat_bin/kill8 delete mode 100644 installation/mods_MarcMentat/2016/Mentat_bin/kill9 delete mode 100644 installation/mods_MarcMentat/2016/Mentat_bin/submit7 delete mode 100644 installation/mods_MarcMentat/2016/Mentat_bin/submit8 delete mode 100644 installation/mods_MarcMentat/2016/Mentat_bin/submit9 delete mode 100644 installation/mods_MarcMentat/2017/Marc_tools/comp_damask delete mode 100644 installation/mods_MarcMentat/2017/Marc_tools/comp_damask_h delete mode 100644 installation/mods_MarcMentat/2017/Marc_tools/comp_damask_l delete mode 100644 installation/mods_MarcMentat/2017/Marc_tools/run_damask delete mode 100644 installation/mods_MarcMentat/2017/Marc_tools/run_damask_h delete mode 100644 installation/mods_MarcMentat/2017/Marc_tools/run_damask_l delete mode 100644 installation/mods_MarcMentat/2017/Mentat_bin/kill7 delete mode 100644 installation/mods_MarcMentat/2017/Mentat_bin/kill8 delete mode 100644 installation/mods_MarcMentat/2017/Mentat_bin/kill9 delete mode 100644 installation/mods_MarcMentat/2017/Mentat_bin/submit7 delete mode 100644 installation/mods_MarcMentat/2017/Mentat_bin/submit8 delete mode 100644 installation/mods_MarcMentat/2017/Mentat_bin/submit9 diff --git a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask b/installation/mods_MarcMentat/2016/Marc_tools/comp_damask deleted file mode 100644 index 2d144b8a4..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_h b/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_h deleted file mode 100644 index 01464f095..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_h +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_l b/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_l deleted file mode 100644 index 31b5cd175..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_l +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2016/Marc_tools/run_damask b/installation/mods_MarcMentat/2016/Marc_tools/run_damask deleted file mode 100644 index 0fc2e639a..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/run_damask +++ /dev/null @@ -1,4112 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=1 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2016/Marc_tools/run_damask_h b/installation/mods_MarcMentat/2016/Marc_tools/run_damask_h deleted file mode 100644 index 182b5fc25..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/run_damask_h +++ /dev/null @@ -1,4112 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=1 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_h $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_h $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2016/Marc_tools/run_damask_l b/installation/mods_MarcMentat/2016/Marc_tools/run_damask_l deleted file mode 100644 index 87cd1e5c6..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/run_damask_l +++ /dev/null @@ -1,4112 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=1 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_l $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_l $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/kill7 b/installation/mods_MarcMentat/2016/Mentat_bin/kill7 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/kill7 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/kill8 b/installation/mods_MarcMentat/2016/Mentat_bin/kill8 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/kill8 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/kill9 b/installation/mods_MarcMentat/2016/Mentat_bin/kill9 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/kill9 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/submit7 b/installation/mods_MarcMentat/2016/Mentat_bin/submit7 deleted file mode 100644 index d0e3be475..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/submit7 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask_h" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/submit8 b/installation/mods_MarcMentat/2016/Mentat_bin/submit8 deleted file mode 100644 index d466fc6ab..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/submit8 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/submit9 b/installation/mods_MarcMentat/2016/Mentat_bin/submit9 deleted file mode 100644 index 207a61803..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/submit9 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask_l" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask b/installation/mods_MarcMentat/2017/Marc_tools/comp_damask deleted file mode 100644 index 2d144b8a4..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_h b/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_h deleted file mode 100644 index 01464f095..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_h +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_l b/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_l deleted file mode 100644 index 31b5cd175..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_l +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2017/Marc_tools/run_damask b/installation/mods_MarcMentat/2017/Marc_tools/run_damask deleted file mode 100644 index 77977db78..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/run_damask +++ /dev/null @@ -1,4122 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=0 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -nsolverprint=$nsolver -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint -# Update print variable for -nsolver option - nsolverprint=$nsolver - if test $nsolver -eq 0 - then - nsolverprint= - fi - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2017/Marc_tools/run_damask_h b/installation/mods_MarcMentat/2017/Marc_tools/run_damask_h deleted file mode 100644 index 6247486b9..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/run_damask_h +++ /dev/null @@ -1,4122 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=0 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -nsolverprint=$nsolver -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint -# Update print variable for -nsolver option - nsolverprint=$nsolver - if test $nsolver -eq 0 - then - nsolverprint= - fi - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_h $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_h $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2017/Marc_tools/run_damask_l b/installation/mods_MarcMentat/2017/Marc_tools/run_damask_l deleted file mode 100644 index d159655db..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/run_damask_l +++ /dev/null @@ -1,4122 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=0 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -nsolverprint=$nsolver -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint -# Update print variable for -nsolver option - nsolverprint=$nsolver - if test $nsolver -eq 0 - then - nsolverprint= - fi - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_l $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_l $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/kill7 b/installation/mods_MarcMentat/2017/Mentat_bin/kill7 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/kill7 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/kill8 b/installation/mods_MarcMentat/2017/Mentat_bin/kill8 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/kill8 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/kill9 b/installation/mods_MarcMentat/2017/Mentat_bin/kill9 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/kill9 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/submit7 b/installation/mods_MarcMentat/2017/Mentat_bin/submit7 deleted file mode 100644 index d0e3be475..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/submit7 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask_h" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/submit8 b/installation/mods_MarcMentat/2017/Mentat_bin/submit8 deleted file mode 100644 index d466fc6ab..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/submit8 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/submit9 b/installation/mods_MarcMentat/2017/Mentat_bin/submit9 deleted file mode 100644 index 207a61803..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/submit9 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask_l" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/apply_DAMASK_modifications.sh b/installation/mods_MarcMentat/apply_DAMASK_modifications.sh index 74abaf29c..d6cd6b171 100755 --- a/installation/mods_MarcMentat/apply_DAMASK_modifications.sh +++ b/installation/mods_MarcMentat/apply_DAMASK_modifications.sh @@ -58,15 +58,9 @@ echo "Editor: $EDITOR" echo '' echo 'adapting Marc tools...' theDIR=$INSTALLDIR/marc$VERSION/tools -for filename in 'comp_damask' \ - 'comp_damask_l' \ - 'comp_damask_h' \ - 'comp_damask_mp' \ +for filename in 'comp_damask_mp' \ 'comp_damask_lmp' \ 'comp_damask_hmp' \ - 'run_damask' \ - 'run_damask_l' \ - 'run_damask_h' \ 'run_damask_mp' \ 'run_damask_lmp' \ 'run_damask_hmp' \ @@ -85,15 +79,9 @@ for filename in 'edit_window' \ 'submit4' \ 'submit5' \ 'submit6' \ - 'submit7' \ - 'submit8' \ - 'submit9' \ 'kill4' \ 'kill5' \ - 'kill6' \ - 'kill7' \ - 'kill8' \ - 'kill9'; do + 'kill6'; do cp $SCRIPTLOCATION/$VERSION/Mentat_bin/$filename $theDIR echo $theDIR/$filename | xargs perl -pi -e "s:%INSTALLDIR%:${INSTALLDIR}:g" echo $theDIR/$filename | xargs perl -pi -e "s:%VERSION%:${VERSION}:g" @@ -122,8 +110,8 @@ echo '' echo 'setting file access rights...' for filename in marc$VERSION/tools/run_damask* \ marc$VERSION/tools/comp_damask* \ - mentat$VERSION/bin/submit{4..9} \ - mentat$VERSION/bin/kill{4..9} ; do + mentat$VERSION/bin/submit{4..6} \ + mentat$VERSION/bin/kill{4..6} ; do chmod 755 $INSTALLDIR/${filename} done @@ -142,10 +130,7 @@ if [ -d "$BIN_DIR" ]; then echo 'creating symlinks ...' echo'' theDIR=$INSTALLDIR/marc$VERSION/tools - for filename in 'run_damask' \ - 'run_damask_l' \ - 'run_damask_h' \ - 'run_damask_mp' \ + for filename in 'run_damask_mp' \ 'run_damask_lmp' \ 'run_damask_hmp'; do echo ${filename:4}$VERSION diff --git a/installation/mods_MarcMentat/installation.txt b/installation/mods_MarcMentat/installation.txt index ae1bca772..c2b56b3e6 100644 --- a/installation/mods_MarcMentat/installation.txt +++ b/installation/mods_MarcMentat/installation.txt @@ -21,16 +21,10 @@ The structure of this directory should be (VERSION = 20XX or 20XX.Y) ./installation.txt this text ./apply_MPIE_modifications script file to apply modifications to the installation ./VERSION/Marc_tools/comp_user.original original file from installation -./VERSION/Marc_tools/comp_damask modified version using -O1 optimization -./VERSION/Marc_tools/comp_damask_l modified version using -O0 optimization -./VERSION/Marc_tools/comp_damask_h modified version using -O2 optimization ./VERSION/Marc_tools/comp_damask_mp modified version using -O1 optimization and OpenMP ./VERSION/Marc_tools/comp_damask_lmp modified version using -O0 optimization and OpenMP ./VERSION/Marc_tools/comp_damask_hmp modified version using -O2 optimization and OpenMP ./VERSION/Marc_tools/run_marc.original original file from installation -./VERSION/Marc_tools/run_damask modified version using -O1 optimization -./VERSION/Marc_tools/run_damask_l modified version using -O0 optimization -./VERSION/Marc_tools/run_damask_h modified version using -O2 optimization ./VERSION/Marc_tools/run_damask_mp modified version using -O1 optimization and OpenMP ./VERSION/Marc_tools/run_damask_lmp modified version using -O0 optimization and OpenMP ./VERSION/Marc_tools/run_damask_hmp modified version using -O2 optimization and OpenMP @@ -42,14 +36,8 @@ The structure of this directory should be (VERSION = 20XX or 20XX.Y) ./VERSION/Mentat_bin/submit4 modified version of original calling run_h_marc ./VERSION/Mentat_bin/submit5 modified version of original calling run_marc ./VERSION/Mentat_bin/submit6 modified version of original calling run_l_marc -./VERSION/Mentat_bin/submit7 modified version of original calling run_hmp_marc -./VERSION/Mentat_bin/submit8 modified version of original calling run_mp_marc -./VERSION/Mentat_bin/submit9 modified version of original calling run_lmp_marc ./VERSION/Mentat_bin/kill4 kill file for submit4, identical to original kill1 ./VERSION/Mentat_bin/kill5 kill file for submit5, identical to original kill1 ./VERSION/Mentat_bin/kill6 kill file for submit6, identical to original kill1 -./VERSION/Mentat_bin/kill7 kill file for submit7, identical to original kill1 -./VERSION/Mentat_bin/kill8 kill file for submit8, identical to original kill1 -./VERSION/Mentat_bin/kill9 kill file for submit9, identical to original kill1 ./VERSION/Mentat_menus/job_run.ms.original original file from installation ./VERSION/Mentat_menus/job_run.ms modified version adding DAMASK menu to run menu From 732022d4f0c9c87cb09ca71a586945df6297f129 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 31 Aug 2018 08:58:13 +0200 Subject: [PATCH 190/208] functions from IO does not add any value here only prevents the automated selection of a new unit --- src/DAMASK_spectral.f90 | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 72db08564..8c908465f 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -27,9 +27,7 @@ program DAMASK_spectral getSolverJobName, & interface_restartInc use IO, only: & - IO_read, & IO_isBlank, & - IO_open_file, & IO_stringPos, & IO_stringValue, & IO_floatValue, & @@ -38,8 +36,7 @@ program DAMASK_spectral IO_lc, & IO_intOut, & IO_warning, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use debug, only: & debug_level, & debug_spectral, & @@ -90,7 +87,7 @@ program DAMASK_spectral ! variables related to information from load case and geom file real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0) logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors - integer(pInt), parameter :: FILEUNIT = 234_pInt !< file unit, DAMASK IO does not support newunit feature + integer(pInt) :: fileUnit, myStat integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & @@ -191,11 +188,11 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! reading basic information from load case file and allocate data structure containing load cases - call IO_open_file(FILEUNIT,trim(loadCaseFile)) - rewind(FILEUNIT) + open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read') + if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile)) do - line = IO_read(FILEUNIT) - if (trim(line) == IO_EOF) exit + read(fileUnit, '(A)', iostat=myStat) line + if ( myStat /= 0_pInt) exit if (IO_isBlank(line)) cycle ! skip empty lines chunkPos = IO_stringPos(line) do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase @@ -233,8 +230,8 @@ program DAMASK_spectral ! reading the load case and assign values to the allocated data structure rewind(FILEUNIT) do - line = IO_read(FILEUNIT) - if (trim(line) == IO_EOF) exit + read(fileUnit, '(A)', iostat=myStat) line + if ( myStat /= 0_pInt) exit if (IO_isBlank(line)) cycle ! skip empty lines currentLoadCase = currentLoadCase + 1_pInt chunkPos = IO_stringPos(line) From c0ac05aa889d255849e468c99a638b80ad119046 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 31 Aug 2018 09:11:09 +0200 Subject: [PATCH 191/208] no need to use two loops --- src/DAMASK_spectral.f90 | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 8c908465f..73f047860 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -133,6 +133,7 @@ program DAMASK_spectral incInfo, & !< string parsed to solution with information about current load case workingDir type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases + type(tLoadCase) :: newLoadCase type(tSolutionState), allocatable, dimension(:) :: solres integer(MPI_OFFSET_KIND) :: fileOffset integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize @@ -188,6 +189,7 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! reading basic information from load case file and allocate data structure containing load cases + allocate (loadCases(0)) ! array of load cases open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read') if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile)) do @@ -205,29 +207,27 @@ program DAMASK_spectral N_n = N_n + 1_pInt end select enddo ! count all identifiers to allocate memory and do sanity check - enddo - - if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check - call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase - allocate (loadCases(N_n)) ! array of load cases - loadCases%stress%myType='stress' - - do i = 1, size(loadCases) - allocate(loadCases(i)%ID(nActiveFields)) + if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check + call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase + loadCases = [loadCases,newLoadCase] + currentLoadCase = currentLoadCase + 1_pInt + loadCases(currentLoadCase)%stress%myType='stress' + allocate(loadCases(currentLoadCase)%ID(nActiveFields)) field = 1 - loadCases(i)%ID(field) = FIELD_MECH_ID ! mechanical active by default + loadCases(currentLoadCase)%ID(field) = FIELD_MECH_ID ! mechanical active by default thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then field = field + 1 - loadCases(i)%ID(field) = FIELD_THERMAL_ID + loadCases(currentLoadCase)%ID(field) = FIELD_THERMAL_ID endif thermalActive damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then field = field + 1 - loadCases(i)%ID(field) = FIELD_DAMAGE_ID + loadCases(currentLoadCase)%ID(field) = FIELD_DAMAGE_ID endif damageActive enddo !-------------------------------------------------------------------------------------------------- ! reading the load case and assign values to the allocated data structure + currentLoadCase = 0_pInt rewind(FILEUNIT) do read(fileUnit, '(A)', iostat=myStat) line @@ -380,7 +380,7 @@ program DAMASK_spectral case(FIELD_MECH_ID) call mech_init - case(FIELD_THERMAL_ID) + case(FIELD_THERMAL_ID) call spectral_thermal_init case(FIELD_DAMAGE_ID) From 017563e0615e073c11e19a29089685d915952170 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 31 Aug 2018 09:14:16 +0200 Subject: [PATCH 192/208] one more loop not needed --- src/DAMASK_spectral.f90 | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 73f047860..92012dcfa 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -223,18 +223,7 @@ program DAMASK_spectral field = field + 1 loadCases(currentLoadCase)%ID(field) = FIELD_DAMAGE_ID endif damageActive - enddo -!-------------------------------------------------------------------------------------------------- -! reading the load case and assign values to the allocated data structure - currentLoadCase = 0_pInt - rewind(FILEUNIT) - do - read(fileUnit, '(A)', iostat=myStat) line - if ( myStat /= 0_pInt) exit - if (IO_isBlank(line)) cycle ! skip empty lines - currentLoadCase = currentLoadCase + 1_pInt - chunkPos = IO_stringPos(line) do i = 1_pInt, chunkPos(1) select case (IO_lc(IO_stringValue(line,chunkPos,i))) case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f') ! assign values for the deformation BC matrix @@ -303,8 +292,10 @@ program DAMASK_spectral enddo loadCases(currentLoadCase)%rotation = math_plain9to33(temp_valueVector) end select - enddo; enddo - close(FILEUNIT) + enddo + enddo + + close(fileUnit) !-------------------------------------------------------------------------------------------------- ! consistency checks and output of load case From 3cb279b083efe798bacffb0e648d7bedc3996b21 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 31 Aug 2018 09:39:33 +0200 Subject: [PATCH 193/208] one more loop not needed --- src/DAMASK_spectral.f90 | 158 +++++++++++++++++++--------------------- 1 file changed, 74 insertions(+), 84 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 92012dcfa..fb67d575d 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -115,7 +115,7 @@ program DAMASK_spectral stagIterate integer(pInt) :: & i, j, k, l, field, & - errorID, & + errorID = 0_pInt, & cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ stepFraction = 0_pInt !< fraction of current time interval integer(pInt) :: & @@ -166,6 +166,7 @@ program DAMASK_spectral if (any(thermal_type == THERMAL_conduction_ID )) nActiveFields = nActiveFields + 1 if (any(damage_type == DAMAGE_nonlocal_ID )) nActiveFields = nActiveFields + 1 allocate(solres(nActiveFields)) + allocate(newLoadCase%ID(nActiveFields)) !-------------------------------------------------------------------------------------------------- ! assign mechanics solver depending on selected type @@ -188,7 +189,7 @@ program DAMASK_spectral end select !-------------------------------------------------------------------------------------------------- -! reading basic information from load case file and allocate data structure containing load cases +! reading information from load case file and to sanity checks allocate (loadCases(0)) ! array of load cases open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read') if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile)) @@ -209,19 +210,17 @@ program DAMASK_spectral enddo ! count all identifiers to allocate memory and do sanity check if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase - loadCases = [loadCases,newLoadCase] - currentLoadCase = currentLoadCase + 1_pInt - loadCases(currentLoadCase)%stress%myType='stress' - allocate(loadCases(currentLoadCase)%ID(nActiveFields)) + + newLoadCase%stress%myType='stress' field = 1 - loadCases(currentLoadCase)%ID(field) = FIELD_MECH_ID ! mechanical active by default + newLoadCase%ID(field) = FIELD_MECH_ID ! mechanical active by default thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then field = field + 1 - loadCases(currentLoadCase)%ID(field) = FIELD_THERMAL_ID + newLoadCase%ID(field) = FIELD_THERMAL_ID endif thermalActive damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then field = field + 1 - loadCases(currentLoadCase)%ID(field) = FIELD_DAMAGE_ID + newLoadCase%ID(field) = FIELD_DAMAGE_ID endif damageActive do i = 1_pInt, chunkPos(1) @@ -230,46 +229,43 @@ program DAMASK_spectral temp_valueVector = 0.0_pReal if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'fdot'.or. & ! in case of Fdot, set type to fdot IO_lc(IO_stringValue(line,chunkPos,i)) == 'dotf') then - loadCases(currentLoadCase)%deformation%myType = 'fdot' + newLoadCase%deformation%myType = 'fdot' else if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'f') then - loadCases(currentLoadCase)%deformation%myType = 'f' + newLoadCase%deformation%myType = 'f' else - loadCases(currentLoadCase)%deformation%myType = 'l' + newLoadCase%deformation%myType = 'l' endif do j = 1_pInt, 9_pInt temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not a * if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable enddo - loadCases(currentLoadCase)%deformation%maskLogical = & ! logical mask in 3x3 notation - transpose(reshape(temp_maskVector,[ 3,3])) - loadCases(currentLoadCase)%deformation%maskFloat = & ! float (1.0/0.0) mask in 3x3 notation - merge(ones,zeros,loadCases(currentLoadCase)%deformation%maskLogical) - loadCases(currentLoadCase)%deformation%values = math_plain9to33(temp_valueVector) ! values in 3x3 notation + newLoadCase%deformation%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) ! logical mask in 3x3 notation + newLoadCase%deformation%maskFloat = merge(ones,zeros,newLoadCase%deformation%maskLogical)! float (1.0/0.0) mask in 3x3 notation + newLoadCase%deformation%values = math_plain9to33(temp_valueVector) ! values in 3x3 notation case('p','pk1','piolakirchhoff','stress', 's') temp_valueVector = 0.0_pReal do j = 1_pInt, 9_pInt temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable enddo - loadCases(currentLoadCase)%stress%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) - loadCases(currentLoadCase)%stress%maskFloat = merge(ones,zeros,& - loadCases(currentLoadCase)%stress%maskLogical) - loadCases(currentLoadCase)%stress%values = math_plain9to33(temp_valueVector) + newLoadCase%stress%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) + newLoadCase%stress%maskFloat = merge(ones,zeros,newLoadCase%stress%maskLogical) + newLoadCase%stress%values = math_plain9to33(temp_valueVector) case('t','time','delta') ! increment time - loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt) + newLoadCase%time = IO_floatValue(line,chunkPos,i+1_pInt) case('n','incs','increments','steps') ! number of increments - loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) + newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt) case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling) - loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) - loadCases(currentLoadCase)%logscale = 1_pInt + newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt) + newLoadCase%logscale = 1_pInt case('freq','frequency','outputfreq') ! frequency of result writings - loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) + newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) case('r','restart','restartwrite') ! frequency of writing restart information - loadCases(currentLoadCase)%restartfrequency = & + newLoadCase%restartfrequency = & max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt)) case('guessreset','dropguessing') - loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory - case('euler') ! rotation of currentLoadCase given in euler angles + newLoadCase%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory + case('euler') ! rotation of load case given in euler angles temp_valueVector = 0.0_pReal l = 1_pInt ! assuming values given in degrees k = 1_pInt ! assuming keyword indicating degree/radians present @@ -284,87 +280,79 @@ program DAMASK_spectral temp_valueVector(j) = IO_floatValue(line,chunkPos,i+k+j) enddo if (l == 1_pInt) temp_valueVector(1:3) = temp_valueVector(1:3) * inRad ! convert to rad - loadCases(currentLoadCase)%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix - case('rotation','rot') ! assign values for the rotation of currentLoadCase matrix + newLoadCase%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix + case('rotation','rot') ! assign values for the rotation matrix temp_valueVector = 0.0_pReal do j = 1_pInt, 9_pInt temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) enddo - loadCases(currentLoadCase)%rotation = math_plain9to33(temp_valueVector) + newLoadCase%rotation = math_plain9to33(temp_valueVector) end select enddo - enddo + currentLoadCase = currentLoadCase + 1_pInt + if(currentLoadCase == 1_pInt) newLoadCase%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first load case - close(fileUnit) - -!-------------------------------------------------------------------------------------------------- -! consistency checks and output of load case - loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase - errorID = 0_pInt - if (worldrank == 0) then - checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases) + reportAndCheck: if (worldrank == 0) then write (loadcase_string, '(i6)' ) currentLoadCase write(6,'(1x,a,i6)') 'load case: ', currentLoadCase - if (.not. loadCases(currentLoadCase)%followFormerTrajectory) & - write(6,'(2x,a)') 'drop guessing along trajectory' - if (loadCases(currentLoadCase)%deformation%myType == 'l') then + if (.not. newLoadCase%followFormerTrajectory) write(6,'(2x,a)') 'drop guessing along trajectory' + if (newLoadCase%deformation%myType == 'l') then do j = 1_pInt, 3_pInt - if (any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .true.) .and. & - any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .false.)) & - errorID = 832_pInt ! each row should be either fully or not at all defined + if (any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .true.) .and. & + any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832_pInt ! each row should be either fully or not at all defined enddo write(6,'(2x,a)') 'velocity gradient:' - else if (loadCases(currentLoadCase)%deformation%myType == 'f') then + else if (newLoadCase%deformation%myType == 'f') then write(6,'(2x,a)') 'deformation gradient at end of load case:' else write(6,'(2x,a)') 'deformation gradient rate:' endif do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt - if(loadCases(currentLoadCase)%deformation%maskLogical(i,j)) then - write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%deformation%values(i,j) + if(newLoadCase%deformation%maskLogical(i,j)) then + write(6,'(2x,f12.7)',advance='no') newLoadCase%deformation%values(i,j) else write(6,'(2x,12a)',advance='no') ' * ' endif enddo; write(6,'(/)',advance='no') enddo - if (any(loadCases(currentLoadCase)%stress%maskLogical .eqv. & - loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only - if (any(loadCases(currentLoadCase)%stress%maskLogical .and. & - transpose(loadCases(currentLoadCase)%stress%maskLogical) .and. & + if (any(newLoadCase%stress%maskLogical .eqv. & + newLoadCase%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only + if (any(newLoadCase%stress%maskLogical .and. & + transpose(newLoadCase%stress%maskLogical) .and. & reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) & errorID = 838_pInt ! no rotation is allowed by stress BC write(6,'(2x,a)') 'stress / GPa:' do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt - if(loadCases(currentLoadCase)%stress%maskLogical(i,j)) then - write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%stress%values(i,j)*1e-9_pReal + if(newLoadCase%stress%maskLogical(i,j)) then + write(6,'(2x,f12.7)',advance='no') newLoadCase%stress%values(i,j)*1e-9_pReal else write(6,'(2x,12a)',advance='no') ' * ' endif enddo; write(6,'(/)',advance='no') enddo - if (any(abs(math_mul33x33(loadCases(currentLoadCase)%rotation, & - math_transpose33(loadCases(currentLoadCase)%rotation))-math_I3) > & + if (any(abs(math_mul33x33(newLoadCase%rotation, & + transpose(newLoadCase%rotation))-math_I3) > & reshape(spread(tol_math_check,1,9),[ 3,3]))& - .or. abs(math_det33(loadCases(currentLoadCase)%rotation)) > & + .or. abs(math_det33(newLoadCase%rotation)) > & 1.0_pReal + tol_math_check) errorID = 846_pInt ! given rotation matrix contains strain - if (any(dNeq(loadCases(currentLoadCase)%rotation, math_I3))) & + if (any(dNeq(newLoadCase%rotation, math_I3))) & write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',& - math_transpose33(loadCases(currentLoadCase)%rotation) - if (loadCases(currentLoadCase)%time < 0.0_pReal) errorID = 834_pInt ! negative time increment - write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time - if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count - write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs - if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency - write(6,'(2x,a,i5)') 'output frequency: ', & - loadCases(currentLoadCase)%outputfrequency - write(6,'(2x,a,i5,/)') 'restart frequency: ', & - loadCases(currentLoadCase)%restartfrequency + transpose(newLoadCase%rotation) + if (newLoadCase%time < 0.0_pReal) errorID = 834_pInt ! negative time increment + write(6,'(2x,a,f12.6)') 'time: ', newLoadCase%time + if (newLoadCase%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count + write(6,'(2x,a,i5)') 'increments: ', newLoadCase%incs + if (newLoadCase%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency + write(6,'(2x,a,i5)') 'output frequency: ', newLoadCase%outputfrequency + write(6,'(2x,a,i5,/)') 'restart frequency: ', newLoadCase%restartfrequency if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message - enddo checkLoadcases - endif + endif reportAndCheck + loadCases = [loadCases,newLoadCase] ! load case is ok, append it + enddo + close(fileUnit) !-------------------------------------------------------------------------------------------------- -! doing initialization depending on selected solver +! doing initialization depending on active solvers call Utilities_init() do field = 1, nActiveFields select case (loadCases(1)%ID(field)) @@ -444,13 +432,13 @@ program DAMASK_spectral fileOffset = fileOffset + sum(outputSize) ! forward to current file position endif writeUndeformed !-------------------------------------------------------------------------------------------------- -! looping over loadcases +! looping over load cases loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) - time0 = time ! currentLoadCase start time + time0 = time ! load case start time guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc !-------------------------------------------------------------------------------------------------- -! loop over incs defined in input file for current currentLoadCase +! loop over incs defined in input file for current load case incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs totalIncsCounter = totalIncsCounter + 1_pInt @@ -460,13 +448,13 @@ program DAMASK_spectral if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal) else - if (currentLoadCase == 1_pInt) then ! 1st currentLoadCase of logarithmic scale - if (inc == 1_pInt) then ! 1st inc of 1st currentLoadCase of logarithmic scale + if (currentLoadCase == 1_pInt) then ! 1st load case of logarithmic scale + if (inc == 1_pInt) then ! 1st inc of 1st load case of logarithmic scale timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd - else ! not-1st inc of 1st currentLoadCase of logarithmic scale + else ! not-1st inc of 1st load case of logarithmic scale timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal)) endif - else ! not-1st currentLoadCase of logarithmic scale + else ! not-1st load case of logarithmic scale timeinc = time0 * & ( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc ,pReal)/& real(loadCases(currentLoadCase)%incs ,pReal))& @@ -633,8 +621,7 @@ program DAMASK_spectral convergedCounter, ' out of ', & notConvergedCounter + convergedCounter, ' (', & real(convergedCounter, pReal)/& - real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, & - ' %) increments converged!' + real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, ' %) increments converged!' flush(6) call MPI_file_close(resUnit,ierr) close(statUnit) @@ -655,10 +642,13 @@ end program DAMASK_spectral !-------------------------------------------------------------------------------------------------- subroutine quit(stop_id) #include - use MPI +#ifdef _OPENMP + use MPI, only: & + MPI_finalize +#endif use prec, only: & pInt - + implicit none integer(pInt), intent(in) :: stop_id integer, dimension(8) :: dateAndTime ! type default integer From f028e0529830d78e04eab8715016724a2232bc17 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 31 Aug 2018 10:14:33 +0200 Subject: [PATCH 194/208] guessing was not correctly set --- src/DAMASK_spectral.f90 | 57 +++++++++++++++++++++-------------------- 1 file changed, 29 insertions(+), 28 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index fb67d575d..b99fb1e1d 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -87,7 +87,6 @@ program DAMASK_spectral ! variables related to information from load case and geom file real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0) logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors - integer(pInt) :: fileUnit, myStat integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & @@ -124,7 +123,8 @@ program DAMASK_spectral totalIncsCounter = 0_pInt, & !< total # of increments convergedCounter = 0_pInt, & !< # of converged increments notConvergedCounter = 0_pInt, & !< # of non-converged increments - resUnit = 0_pInt, & !< file unit for results writing + fileUnit = 0_pInt, & !< file unit for reading load case and writing results + myStat, & statUnit = 0_pInt, & !< file unit for statistics output lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written stagIter @@ -223,7 +223,7 @@ program DAMASK_spectral newLoadCase%ID(field) = FIELD_DAMAGE_ID endif damageActive - do i = 1_pInt, chunkPos(1) + readIn: do i = 1_pInt, chunkPos(1) select case (IO_lc(IO_stringValue(line,chunkPos,i))) case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f') ! assign values for the deformation BC matrix temp_valueVector = 0.0_pReal @@ -288,9 +288,10 @@ program DAMASK_spectral enddo newLoadCase%rotation = math_plain9to33(temp_valueVector) end select - enddo + enddo readIn + currentLoadCase = currentLoadCase + 1_pInt - if(currentLoadCase == 1_pInt) newLoadCase%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first load case + newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1_pInt) ! by default, guess from previous load case reportAndCheck: if (worldrank == 0) then write (loadcase_string, '(i6)' ) currentLoadCase @@ -372,22 +373,22 @@ program DAMASK_spectral ! write header of output file if (worldrank == 0) then writeHeader: if (interface_restartInc < 1_pInt) then - open(newunit=resUnit,file=trim(getSolverJobName())//& + open(newunit=fileUnit,file=trim(getSolverJobName())//& '.spectralOut',form='UNFORMATTED',status='REPLACE') - write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header - write(resUnit) 'workingdir:', trim(workingDir) - write(resUnit) 'geometry:', trim(geometryFile) - write(resUnit) 'grid:', grid - write(resUnit) 'size:', geomSize - write(resUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults - write(resUnit) 'loadcases:', size(loadCases) - write(resUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase - write(resUnit) 'times:', loadCases%time ! one entry per LoadCase - write(resUnit) 'logscales:', loadCases%logscale - write(resUnit) 'increments:', loadCases%incs ! one entry per LoadCase - write(resUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc - write(resUnit) 'eoh' - close(resUnit) ! end of header + write(fileUnit) 'load:', trim(loadCaseFile) ! ... and write header + write(fileUnit) 'workingdir:', trim(workingDir) + write(fileUnit) 'geometry:', trim(geometryFile) + write(fileUnit) 'grid:', grid + write(fileUnit) 'size:', geomSize + write(fileUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults + write(fileUnit) 'loadcases:', size(loadCases) + write(fileUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase + write(fileUnit) 'times:', loadCases%time ! one entry per LoadCase + write(fileUnit) 'logscales:', loadCases%logscale + write(fileUnit) 'increments:', loadCases%incs ! one entry per LoadCase + write(fileUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc + write(fileUnit) 'eoh' + close(fileUnit) ! end of header open(newunit=statUnit,file=trim(getSolverJobName())//& '.sta',form='FORMATTED',status='REPLACE') write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file @@ -409,13 +410,13 @@ program DAMASK_spectral call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', & MPI_MODE_WRONLY + MPI_MODE_APPEND, & MPI_INFO_NULL, & - resUnit, & + fileUnit, & ierr) if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_open') - call MPI_file_get_position(resUnit,fileOffset,ierr) ! get offset from header + call MPI_file_get_position(fileUnit,fileOffset,ierr) ! get offset from header if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_get_position') fileOffset = fileOffset + sum(outputSize(1:worldrank)) ! offset of my process in file (header + processes before me) - call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) + call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr) if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek') writeUndeformed: if (interface_restartInc < 1_pInt) then @@ -423,7 +424,7 @@ program DAMASK_spectral do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1? min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) - call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & + call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)), & MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) @@ -565,7 +566,7 @@ program DAMASK_spectral write(6,'(/,a)') ' cutting back ' else ! no more options to continue call IO_warning(850_pInt) - call MPI_file_close(resUnit,ierr) + call MPI_file_close(fileUnit,ierr) close(statUnit) call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written endif @@ -588,12 +589,12 @@ program DAMASK_spectral write(6,'(1/,a)') ' ... writing results to file ......................................' flush(6) call materialpoint_postResults() - call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) + call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr) if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) - call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),& + call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),& [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)),& MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) @@ -623,7 +624,7 @@ program DAMASK_spectral real(convergedCounter, pReal)/& real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, ' %) increments converged!' flush(6) - call MPI_file_close(resUnit,ierr) + call MPI_file_close(fileUnit,ierr) close(statUnit) if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged From 5330fb31adb79b27d1709d073f873c83c1301d7e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 31 Aug 2018 10:19:37 +0200 Subject: [PATCH 195/208] more verbose error message --- src/DAMASK_spectral.f90 | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index b99fb1e1d..ee5af421c 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -190,13 +190,16 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! reading information from load case file and to sanity checks - allocate (loadCases(0)) ! array of load cases + allocate (loadCases(0)) ! array of load cases open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read') if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile)) do read(fileUnit, '(A)', iostat=myStat) line if ( myStat /= 0_pInt) exit if (IO_isBlank(line)) cycle ! skip empty lines + + currentLoadCase = currentLoadCase + 1_pInt + chunkPos = IO_stringPos(line) do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase select case (IO_lc(IO_stringValue(line,chunkPos,i))) @@ -207,13 +210,13 @@ program DAMASK_spectral case('n','incs','increments','steps','logincs','logincrements','logsteps') N_n = N_n + 1_pInt end select - enddo ! count all identifiers to allocate memory and do sanity check - if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check - call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase + enddo + if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check + call IO_error(error_ID=837_pInt,el=currentLoadCase,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase newLoadCase%stress%myType='stress' field = 1 - newLoadCase%ID(field) = FIELD_MECH_ID ! mechanical active by default + newLoadCase%ID(field) = FIELD_MECH_ID ! mechanical active by default thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then field = field + 1 newLoadCase%ID(field) = FIELD_THERMAL_ID @@ -290,7 +293,6 @@ program DAMASK_spectral end select enddo readIn - currentLoadCase = currentLoadCase + 1_pInt newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1_pInt) ! by default, guess from previous load case reportAndCheck: if (worldrank == 0) then From 3e811108309c3474f973ccdc56447391642af5c4 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 31 Aug 2018 11:22:59 -0400 Subject: [PATCH 196/208] tell user whether DEBUG version or not --- src/DAMASK_spectral.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 2ed94d06a..c60593912 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -154,6 +154,9 @@ program DAMASK_spectral ! init DAMASK (all modules) call CPFEM_initAll(el = 1_pInt, ip = 1_pInt) write(6,'(/,a)') ' <<<+- DAMASK_spectral init -+>>>' +#ifdef DEBUG + write(6,'(/,a)') ' <<<+- DEBUG version -+>>>' +#endif write(6,'(/,a,/)') ' Roters et al., Computational Materials Science, 2018' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From b66b01e65da6157c52177b61048ef48d4bded236 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 31 Aug 2018 20:52:04 +0200 Subject: [PATCH 197/208] [skip ci] updated version information after successful test of v2.0.2-492-gb24ebb8a --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index c1e114a98..9615f9d5f 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-490-g29e55d20 +v2.0.2-492-gb24ebb8a From 36f0e9141d4e0ca06fe8e54cc3c978d81f47c53e Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 1 Sep 2018 12:39:08 +0200 Subject: [PATCH 198/208] [skip ci] updated version information after successful test of v2.0.2-494-g6a64637a --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index c1e114a98..79ff3e2f6 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-490-g29e55d20 +v2.0.2-494-g6a64637a From e8a0cd507b6cd6d005570fdabd71eb4cc467f540 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 5 Sep 2018 23:37:33 +0200 Subject: [PATCH 199/208] test compatible with new-style dislotwin --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index fa02113fa..b64eb647f 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit fa02113fa7a0af3376648e4320318ec337fe79aa +Subproject commit b64eb647f30766f3f58daf44e843b9f1e4e5f5e4 From 3966659ac990cef5f70a33a63ac7671d66a24df3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 6 Sep 2018 16:18:06 +0200 Subject: [PATCH 200/208] to easily see start and end of each job --- .gitlab-ci.yml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index caa411bb8..5833fda97 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -29,7 +29,12 @@ before_script: done - source $DAMASKROOT/env/DAMASK.sh - cd $DAMASKROOT/PRIVATE/testing + - echo "Job start: $(date)" +################################################################################################### +after_script: + - echo "Job end: $(date)" +# ################################################################################################### variables: # =============================================================================================== From e70efd2608bcb1623e02e5702637f61168e4bbb8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 6 Sep 2018 16:49:39 +0200 Subject: [PATCH 201/208] inform about debug versions indenpendently of the solver --- src/DAMASK_spectral.f90 | 3 --- src/debug.f90 | 3 +++ 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index c907abe07..ee5af421c 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -156,9 +156,6 @@ program DAMASK_spectral ! init DAMASK (all modules) call CPFEM_initAll(el = 1_pInt, ip = 1_pInt) write(6,'(/,a)') ' <<<+- DAMASK_spectral init -+>>>' -#ifdef DEBUG - write(6,'(/,a)') ' <<<+- DEBUG version -+>>>' -#endif write(6,'(/,a,/)') ' Roters et al., Computational Materials Science, 2018' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/debug.f90 b/src/debug.f90 index 2a4edf28e..6debf84c2 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -109,6 +109,9 @@ subroutine debug_init character(len=65536) :: tag, line write(6,'(/,a)') ' <<<+- debug init -+>>>' +#ifdef DEBUG + write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m' +#endif write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From 24fb2d0e5ccabadc2fe0c814db995f7af7e7c5eb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 6 Sep 2018 16:54:35 +0200 Subject: [PATCH 202/208] testing compatible with 20-xxx branch --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index b64eb647f..2c40bb79f 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit b64eb647f30766f3f58daf44e843b9f1e4e5f5e4 +Subproject commit 2c40bb79f9a57d2178eb7be0e533fd5104f9f87e From 6beb74f6d12fc19c7c7902a3c03b7a19e85ddb27 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 6 Sep 2018 17:58:12 +0200 Subject: [PATCH 203/208] ticks caused trouble, not entirely clear why --- .gitlab-ci.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 5833fda97..61cad252f 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -29,12 +29,12 @@ before_script: done - source $DAMASKROOT/env/DAMASK.sh - cd $DAMASKROOT/PRIVATE/testing - - echo "Job start: $(date)" + - echo Job start: $(date) ################################################################################################### after_script: - - echo "Job end: $(date)" -# + - echo Job end: $(date) + ################################################################################################### variables: # =============================================================================================== From bfa56e9bffc2856bb4a8cf27e1d8e7c309159604 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 6 Sep 2018 18:07:40 +0200 Subject: [PATCH 204/208] a colon followed by a white space seems to be the problem --- .gitlab-ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 61cad252f..29ded97dc 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -29,11 +29,11 @@ before_script: done - source $DAMASKROOT/env/DAMASK.sh - cd $DAMASKROOT/PRIVATE/testing - - echo Job start: $(date) + - echo Job start:" $(date)" ################################################################################################### after_script: - - echo Job end: $(date) + - echo Job end:" $(date)" ################################################################################################### variables: From 6c3b5f17eb6d05a8637f18e454fa03117b5b7fd0 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 6 Sep 2018 14:19:09 -0400 Subject: [PATCH 205/208] updated orientation/quaternion class to follow Rowenhorst_etal2015 --- lib/damask/orientation.py | 160 +++++++++++++------------------------- 1 file changed, 53 insertions(+), 107 deletions(-) diff --git a/lib/damask/orientation.py b/lib/damask/orientation.py index 7d97d2c81..17e5e3e58 100644 --- a/lib/damask/orientation.py +++ b/lib/damask/orientation.py @@ -30,12 +30,19 @@ class Quaternion: """ Orientation represented as unit quaternion. - All methods and naming conventions based on http://www.euclideanspace.com/maths/algebra/realNormedAlgebra/quaternions. + All methods and naming conventions based on Rowenhorst_etal2015 + Convention 1: coordinate frames are right-handed + Convention 2: a rotation angle ω is taken to be positive for a counterclockwise rotation + when viewing from the end point of the rotation axis unit vector towards the origin + Convention 3: rotations will be interpreted in the passive sense + Convention 4: Euler angle triplets are implemented using the Bunge convention, + with the angular ranges as [0, 2π],[0, π],[0, 2π] + Convention 5: the rotation angle ω is limited to the interval [0, π] w is the real part, (x, y, z) are the imaginary parts. - Representation of rotation is in ACTIVE form! - (Derived directly or through angleAxis, Euler angles, or active matrix) - Vector "a" (defined in coordinate system "A") is actively rotated to new coordinates "b". + + Vector "a" (defined in coordinate system "A") is passively rotated + resulting in new coordinates "b" when expressed in system "B". b = Q * a b = np.dot(Q.asMatrix(),a) """ @@ -309,10 +316,12 @@ class Quaternion: return np.outer([i for i in self],[i for i in self]) def asMatrix(self): - return np.array( - [[1.0-2.0*(self.y*self.y+self.z*self.z), 2.0*(self.x*self.y-self.z*self.w), 2.0*(self.x*self.z+self.y*self.w)], - [ 2.0*(self.x*self.y+self.z*self.w), 1.0-2.0*(self.x*self.x+self.z*self.z), 2.0*(self.y*self.z-self.x*self.w)], - [ 2.0*(self.x*self.z-self.y*self.w), 2.0*(self.x*self.w+self.y*self.z), 1.0-2.0*(self.x*self.x+self.y*self.y)]]) + qbarhalf = 0.5*(self.w**2 - self.x**2 - self.y**2 - self.z**2) + return 2.0*np.array( + [[ qbarhalf + self.x**2 , self.x*self.y - self.w*self.z, self.x*self.z + self.w*self.y], + [ self.x*self.y + self.w*self.z, qbarhalf + self.y**2 , self.y*self.z - self.w*self.x], + [ self.x*self.z - self.w*self.y, self.y*self.z + self.w*self.x, qbarhalf + self.z**2 ], + ]) def asAngleAxis(self, degrees = False): @@ -335,52 +344,28 @@ class Quaternion: return np.inf*np.ones(3) if self.w == 0.0 else np.array([self.x, self.y, self.z])/self.w def asEulers(self, - type = "bunge", degrees = False, - standardRange = False): + ): """ Orientation as Bunge-Euler angles. - Conversion of ACTIVE rotation to Euler angles taken from: - Melcher, A.; Unser, A.; Reichhardt, M.; Nestler, B.; Poetschke, M.; Selzer, M. - Conversion of EBSD data by a quaternion based algorithm to be used for grain structure simulations - Technische Mechanik 30 (2010) pp 401--413. """ - angles = [0.0,0.0,0.0] - if type.lower() == 'bunge' or type.lower() == 'zxz': - if abs(self.x) < 1e-4 and abs(self.y) < 1e-4: - x = self.w**2 - self.z**2 - y = 2.*self.w*self.z - angles[0] = math.atan2(y,x) - elif abs(self.w) < 1e-4 and abs(self.z) < 1e-4: - x = self.x**2 - self.y**2 - y = 2.*self.x*self.y - angles[0] = math.atan2(y,x) - angles[1] = math.pi - else: - chi = math.sqrt((self.w**2 + self.z**2)*(self.x**2 + self.y**2)) + q03 = self.w**2+self.z**2 + q12 = self.x**2+self.y**2 + chi = np.sqrt(q03*q12) + + if abs(chi) < 1e-10 and abs(q12) < 1e-10: + eulers = np.array([math.atan2(-2*self.w*self.z,self.w**2-self.z**2),0,0]) + elif abs(chi) < 1e-10 and abs(q03) < 1e-10: + eulers = np.array([math.atan2( 2*self.x*self.y,self.x**2-self.y**2),np.pi,0]) + else: + eulers = np.array([math.atan2((self.x*self.z-self.w*self.y)/chi,(-self.w*self.x-self.y*self.z)/chi), + math.atan2(2*chi,q03-q12), + math.atan2((self.w*self.y+self.x*self.z)/chi,( self.y*self.z-self.w*self.x)/chi), + ]) - x = (self.w * self.x - self.y * self.z)/2./chi - y = (self.w * self.y + self.x * self.z)/2./chi - angles[0] = math.atan2(y,x) - - x = self.w**2 + self.z**2 - (self.x**2 + self.y**2) - y = 2.*chi - angles[1] = math.atan2(y,x) - - x = (self.w * self.x + self.y * self.z)/2./chi - y = (self.z * self.x - self.y * self.w)/2./chi - angles[2] = math.atan2(y,x) - - if standardRange: - angles[0] %= 2*math.pi - if angles[1] < 0.0: - angles[1] += math.pi - angles[2] *= -1.0 - angles[2] %= 2*math.pi - - return np.degrees(angles) if degrees else angles + return np.degrees(eulers) if degrees else eulers # # Static constructors @@ -408,7 +393,7 @@ class Quaternion: halfangle = math.atan(np.linalg.norm(rodrigues)) c = math.cos(halfangle) w = c - x,y,z = c*rodrigues + x,y,z = rodrigues/c return cls([w,x,y,z]) @@ -431,24 +416,19 @@ class Quaternion: @classmethod def fromEulers(cls, eulers, - type = 'Bunge', degrees = False): if not isinstance(eulers, np.ndarray): eulers = np.array(eulers,dtype='d') eulers = np.radians(eulers) if degrees else eulers - c = np.cos(0.5 * eulers) - s = np.sin(0.5 * eulers) + sigma = 0.5*(eulers[0]+eulers[2]) + delta = 0.5*(eulers[0]-eulers[2]) + c = np.cos(0.5*eulers[1]) + s = np.sin(0.5*eulers[1]) - if type.lower() == 'bunge' or type.lower() == 'zxz': - w = c[0] * c[1] * c[2] - s[0] * c[1] * s[2] - x = c[0] * s[1] * c[2] + s[0] * s[1] * s[2] - y = - c[0] * s[1] * s[2] + s[0] * s[1] * c[2] - z = c[0] * c[1] * s[2] + s[0] * c[1] * c[2] - else: - w = c[0] * c[1] * c[2] - s[0] * s[1] * s[2] - x = s[0] * s[1] * c[2] + c[0] * c[1] * s[2] - y = s[0] * c[1] * c[2] + c[0] * s[1] * s[2] - z = c[0] * s[1] * c[2] - s[0] * c[1] * s[2] + w = c * np.cos(sigma) + x = -s * np.cos(delta) + y = -s * np.sin(delta) + z = -c * np.sin(sigma) return cls([w,x,y,z]) @@ -460,49 +440,16 @@ class Quaternion: if m.shape != (3,3) and np.prod(m.shape) == 9: m = m.reshape(3,3) - tr = np.trace(m) - if tr > 1e-8: - s = math.sqrt(tr + 1.0)*2.0 + w = 0.5*math.sqrt(1.+m[0,0]+m[1,1]+m[2,2]) + x = 0.5*math.sqrt(1.+m[0,0]-m[1,1]-m[2,2]) + y = 0.5*math.sqrt(1.-m[0,0]+m[1,1]-m[2,2]) + z = 0.5*math.sqrt(1.-m[0,0]-m[1,1]+m[2,2]) - return cls( - [ s*0.25, - (m[2,1] - m[1,2])/s, - (m[0,2] - m[2,0])/s, - (m[1,0] - m[0,1])/s, - ]) + x *= -1 if m[2,1] < m[1,2] else 1 + y *= -1 if m[0,2] < m[2,0] else 1 + z *= -1 if m[1,0] < m[0,1] else 1 - elif m[0,0] > m[1,1] and m[0,0] > m[2,2]: - t = m[0,0] - m[1,1] - m[2,2] + 1.0 - s = 2.0*math.sqrt(t) - - return cls( - [ (m[2,1] - m[1,2])/s, - s*0.25, - (m[0,1] + m[1,0])/s, - (m[2,0] + m[0,2])/s, - ]) - - elif m[1,1] > m[2,2]: - t = -m[0,0] + m[1,1] - m[2,2] + 1.0 - s = 2.0*math.sqrt(t) - - return cls( - [ (m[0,2] - m[2,0])/s, - (m[0,1] + m[1,0])/s, - s*0.25, - (m[1,2] + m[2,1])/s, - ]) - - else: - t = -m[0,0] - m[1,1] + m[2,2] + 1.0 - s = 2.0*math.sqrt(t) - - return cls( - [ (m[1,0] - m[0,1])/s, - (m[2,0] + m[0,2])/s, - (m[1,2] + m[2,1])/s, - s*0.25, - ]) + return cls( np.array([w,x,y,z])/math.sqrt(w**2 + x**2 + y**2 + z**2)) @classmethod @@ -829,7 +776,7 @@ class Orientation: else: self.quaternion = Quaternion.fromRandom(randomSeed=random) elif isinstance(Eulers, np.ndarray) and Eulers.shape == (3,): # based on given Euler angles - self.quaternion = Quaternion.fromEulers(Eulers,type='bunge',degrees=degrees) + self.quaternion = Quaternion.fromEulers(Eulers,degrees=degrees) elif isinstance(matrix, np.ndarray) : # based on given rotation matrix self.quaternion = Quaternion.fromMatrix(matrix) elif isinstance(angleAxis, np.ndarray) and angleAxis.shape == (4,): # based on given angle and rotation axis @@ -855,16 +802,15 @@ class Orientation: return 'Symmetry: %s\n' % (self.symmetry) + \ 'Quaternion: %s\n' % (self.quaternion) + \ 'Matrix:\n%s\n' % ( '\n'.join(['\t'.join(map(str,self.asMatrix()[i,:])) for i in range(3)]) ) + \ - 'Bunge Eulers / deg: %s' % ('\t'.join(map(str,self.asEulers('bunge',degrees=True))) ) + 'Bunge Eulers / deg: %s' % ('\t'.join(map(str,self.asEulers(degrees=True))) ) def asQuaternion(self): return self.quaternion.asList() def asEulers(self, - type = 'bunge', degrees = False, - standardRange = False): - return self.quaternion.asEulers(type, degrees, standardRange) + ): + return self.quaternion.asEulers(degrees) eulers = property(asEulers) def asRodrigues(self): From a16454f1f98a0ecd24cd800cff947c4aa22a7856 Mon Sep 17 00:00:00 2001 From: Satyapriya Gupta Date: Thu, 6 Sep 2018 16:43:29 -0400 Subject: [PATCH 206/208] fixed missing propagation of dependent state variables --- src/crystallite.f90 | 30 +++++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b9ae84a44..4b365c68d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -174,10 +174,11 @@ subroutine crystallite_init use config, only: & config_deallocate, & config_crystallite, & - crystallite_name + crystallite_name, & + material_Nphase use constitutive, only: & constitutive_initialFi, & - constitutive_microstructure ! derived (shortcut) quantities of given state + constitutive_microstructure ! derived (shortcut) quantities of given state implicit none @@ -187,7 +188,8 @@ subroutine crystallite_init i, & !< counter in integration point loop e, & !< counter in element loop o = 0_pInt, & !< counter in output loop - r, & !< counter in crystallite loop + r, & + ph, & !< counter in crystallite loop cMax, & !< maximum number of integration point components iMax, & !< maximum number of integration points eMax, & !< maximum number of elements @@ -421,6 +423,19 @@ subroutine crystallite_init enddo !$OMP END PARALLEL DO + do ph = 1_pInt,material_Nphase +!-------------------------------------------------------------------------------------------------- +! propagate dependent states to materialpoint and boundary value problem level + plasticState(ph)%partionedState0(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & + plasticState(ph)%sizeState,:) & + = plasticState(ph)%state(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & + plasticState(ph)%sizeState,:) + plasticState(ph)%state0 (plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & + plasticState(ph)%sizeState,:) & + = plasticState(ph)%state(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & + plasticState(ph)%sizeState,:) + enddo + call crystallite_stressAndItsTangent(.true.) ! request elastic answers crystallite_fallbackdPdF = crystallite_dPdF ! use initial elastic stiffness as fallback @@ -614,6 +629,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) if (crystallite_requested(c,i,e)) then plasticState (phaseAt(c,i,e))%subState0( :,phasememberAt(c,i,e)) = & plasticState (phaseAt(c,i,e))%partionedState0(:,phasememberAt(c,i,e)) + do mySource = 1_pInt, phase_Nsources(phaseAt(c,i,e)) sourceState(phaseAt(c,i,e))%p(mySource)%subState0( :,phasememberAt(c,i,e)) = & sourceState(phaseAt(c,i,e))%p(mySource)%partionedState0(:,phasememberAt(c,i,e)) @@ -990,7 +1006,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) timeSyncing2: if(numerics_timeSyncing) then if (any(.not. crystallite_localPlasticity .and. .not. crystallite_todo .and. .not. crystallite_converged & - .and. crystallite_subStep <= subStepMinCryst)) then ! no way of rescuing a nonlocal ip that violated the lower time step limit, ... + .and. crystallite_subStep <= subStepMinCryst)) then ! no way of rescuing a nonlocal ip that violated the lower time step limit, ... if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNcomponents = homogenization_Ngrains(mesh_element(3,e)) @@ -1004,7 +1020,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) enddo elementLooping4 endif where(.not. crystallite_localPlasticity) - crystallite_todo = .false. ! ... so let all nonlocal ips die peacefully + crystallite_todo = .false. ! ... so let all nonlocal ips die peacefully crystallite_subStep = 0.0_pReal endwhere endif @@ -1056,9 +1072,9 @@ subroutine crystallite_stressAndItsTangent(updateJaco) elementLooping5: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNcomponents = 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 do c = 1,myNcomponents - if (.not. crystallite_converged(c,i,e)) then ! respond fully elastically (might be not required due to becoming terminally ill anyway) + if (.not. crystallite_converged(c,i,e)) then ! respond fully elastically (might be not required due to becoming terminally ill anyway) if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,/)') '<< CRYST >> no convergence: respond fully elastic at el (elFE) ip ipc ', & e,'(',mesh_element(1,e),')',i,c From 0a8dd880d155f5f507c2b490fe136bf3eb6a8d38 Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 8 Sep 2018 05:32:52 +0200 Subject: [PATCH 207/208] [skip ci] updated version information after successful test of v2.0.2-514-gbfa56e9b --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 9615f9d5f..069730c70 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-492-gb24ebb8a +v2.0.2-514-gbfa56e9b From 07dcdc9fc62f1afa303447a813689bd6e6ad533a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 11 Sep 2018 02:10:55 +0200 Subject: [PATCH 208/208] undoes commit 6c3b5f17eb6d05a8637f18e454fa03117b5b7fd0 tests fail, needs closer look. Changes incorporated into 10-consistent-orientation-conversions-in-the-damask-core-and-the-python-module --- lib/damask/orientation.py | 169 +++++++++++++++++++++++++------------- 1 file changed, 114 insertions(+), 55 deletions(-) diff --git a/lib/damask/orientation.py b/lib/damask/orientation.py index ea0986762..7d97d2c81 100644 --- a/lib/damask/orientation.py +++ b/lib/damask/orientation.py @@ -27,22 +27,15 @@ class Rodrigues: # ****************************************************************************************** class Quaternion: - u""" + """ Orientation represented as unit quaternion. - All methods and naming conventions based on Rowenhorst_etal2015 - Convention 1: coordinate frames are right-handed - Convention 2: a rotation angle ω is taken to be positive for a counterclockwise rotation - when viewing from the end point of the rotation axis unit vector towards the origin - Convention 3: rotations will be interpreted in the passive sense - Convention 4: Euler angle triplets are implemented using the Bunge convention, - with the angular ranges as [0, 2π],[0, π],[0, 2π] - Convention 5: the rotation angle ω is limited to the interval [0, π] + All methods and naming conventions based on http://www.euclideanspace.com/maths/algebra/realNormedAlgebra/quaternions. w is the real part, (x, y, z) are the imaginary parts. - - Vector "a" (defined in coordinate system "A") is passively rotated - resulting in new coordinates "b" when expressed in system "B". + Representation of rotation is in ACTIVE form! + (Derived directly or through angleAxis, Euler angles, or active matrix) + Vector "a" (defined in coordinate system "A") is actively rotated to new coordinates "b". b = Q * a b = np.dot(Q.asMatrix(),a) """ @@ -316,12 +309,10 @@ class Quaternion: return np.outer([i for i in self],[i for i in self]) def asMatrix(self): - qbarhalf = 0.5*(self.w**2 - self.x**2 - self.y**2 - self.z**2) - return 2.0*np.array( - [[ qbarhalf + self.x**2 , self.x*self.y - self.w*self.z, self.x*self.z + self.w*self.y], - [ self.x*self.y + self.w*self.z, qbarhalf + self.y**2 , self.y*self.z - self.w*self.x], - [ self.x*self.z - self.w*self.y, self.y*self.z + self.w*self.x, qbarhalf + self.z**2 ], - ]) + return np.array( + [[1.0-2.0*(self.y*self.y+self.z*self.z), 2.0*(self.x*self.y-self.z*self.w), 2.0*(self.x*self.z+self.y*self.w)], + [ 2.0*(self.x*self.y+self.z*self.w), 1.0-2.0*(self.x*self.x+self.z*self.z), 2.0*(self.y*self.z-self.x*self.w)], + [ 2.0*(self.x*self.z-self.y*self.w), 2.0*(self.x*self.w+self.y*self.z), 1.0-2.0*(self.x*self.x+self.y*self.y)]]) def asAngleAxis(self, degrees = False): @@ -344,23 +335,52 @@ class Quaternion: return np.inf*np.ones(3) if self.w == 0.0 else np.array([self.x, self.y, self.z])/self.w def asEulers(self, - degrees = False): - """Orientation as Bunge-Euler angles.""" - q03 = self.w**2+self.z**2 - q12 = self.x**2+self.y**2 - chi = np.sqrt(q03*q12) - - if abs(chi) < 1e-10 and abs(q12) < 1e-10: - eulers = np.array([math.atan2(-2*self.w*self.z,self.w**2-self.z**2),0,0]) - elif abs(chi) < 1e-10 and abs(q03) < 1e-10: - eulers = np.array([math.atan2( 2*self.x*self.y,self.x**2-self.y**2),np.pi,0]) - else: - eulers = np.array([math.atan2((self.x*self.z-self.w*self.y)/chi,(-self.w*self.x-self.y*self.z)/chi), - math.atan2(2*chi,q03-q12), - math.atan2((self.w*self.y+self.x*self.z)/chi,( self.y*self.z-self.w*self.x)/chi), - ]) + type = "bunge", + degrees = False, + standardRange = False): + """ + Orientation as Bunge-Euler angles. - return np.degrees(eulers) if degrees else eulers + Conversion of ACTIVE rotation to Euler angles taken from: + Melcher, A.; Unser, A.; Reichhardt, M.; Nestler, B.; Poetschke, M.; Selzer, M. + Conversion of EBSD data by a quaternion based algorithm to be used for grain structure simulations + Technische Mechanik 30 (2010) pp 401--413. + """ + angles = [0.0,0.0,0.0] + + if type.lower() == 'bunge' or type.lower() == 'zxz': + if abs(self.x) < 1e-4 and abs(self.y) < 1e-4: + x = self.w**2 - self.z**2 + y = 2.*self.w*self.z + angles[0] = math.atan2(y,x) + elif abs(self.w) < 1e-4 and abs(self.z) < 1e-4: + x = self.x**2 - self.y**2 + y = 2.*self.x*self.y + angles[0] = math.atan2(y,x) + angles[1] = math.pi + else: + chi = math.sqrt((self.w**2 + self.z**2)*(self.x**2 + self.y**2)) + + x = (self.w * self.x - self.y * self.z)/2./chi + y = (self.w * self.y + self.x * self.z)/2./chi + angles[0] = math.atan2(y,x) + + x = self.w**2 + self.z**2 - (self.x**2 + self.y**2) + y = 2.*chi + angles[1] = math.atan2(y,x) + + x = (self.w * self.x + self.y * self.z)/2./chi + y = (self.z * self.x - self.y * self.w)/2./chi + angles[2] = math.atan2(y,x) + + if standardRange: + angles[0] %= 2*math.pi + if angles[1] < 0.0: + angles[1] += math.pi + angles[2] *= -1.0 + angles[2] %= 2*math.pi + + return np.degrees(angles) if degrees else angles # # Static constructors @@ -388,7 +408,7 @@ class Quaternion: halfangle = math.atan(np.linalg.norm(rodrigues)) c = math.cos(halfangle) w = c - x,y,z = rodrigues/c + x,y,z = c*rodrigues return cls([w,x,y,z]) @@ -411,19 +431,24 @@ class Quaternion: @classmethod def fromEulers(cls, eulers, + type = 'Bunge', degrees = False): if not isinstance(eulers, np.ndarray): eulers = np.array(eulers,dtype='d') eulers = np.radians(eulers) if degrees else eulers - sigma = 0.5*(eulers[0]+eulers[2]) - delta = 0.5*(eulers[0]-eulers[2]) - c = np.cos(0.5*eulers[1]) - s = np.sin(0.5*eulers[1]) + c = np.cos(0.5 * eulers) + s = np.sin(0.5 * eulers) - w = c * np.cos(sigma) - x = -s * np.cos(delta) - y = -s * np.sin(delta) - z = -c * np.sin(sigma) + if type.lower() == 'bunge' or type.lower() == 'zxz': + w = c[0] * c[1] * c[2] - s[0] * c[1] * s[2] + x = c[0] * s[1] * c[2] + s[0] * s[1] * s[2] + y = - c[0] * s[1] * s[2] + s[0] * s[1] * c[2] + z = c[0] * c[1] * s[2] + s[0] * c[1] * c[2] + else: + w = c[0] * c[1] * c[2] - s[0] * s[1] * s[2] + x = s[0] * s[1] * c[2] + c[0] * c[1] * s[2] + y = s[0] * c[1] * c[2] + c[0] * s[1] * s[2] + z = c[0] * s[1] * c[2] - s[0] * c[1] * s[2] return cls([w,x,y,z]) @@ -435,16 +460,49 @@ class Quaternion: if m.shape != (3,3) and np.prod(m.shape) == 9: m = m.reshape(3,3) - w = 0.5*math.sqrt(1.+m[0,0]+m[1,1]+m[2,2]) - x = 0.5*math.sqrt(1.+m[0,0]-m[1,1]-m[2,2]) - y = 0.5*math.sqrt(1.-m[0,0]+m[1,1]-m[2,2]) - z = 0.5*math.sqrt(1.-m[0,0]-m[1,1]+m[2,2]) + tr = np.trace(m) + if tr > 1e-8: + s = math.sqrt(tr + 1.0)*2.0 - x *= -1 if m[2,1] < m[1,2] else 1 - y *= -1 if m[0,2] < m[2,0] else 1 - z *= -1 if m[1,0] < m[0,1] else 1 + return cls( + [ s*0.25, + (m[2,1] - m[1,2])/s, + (m[0,2] - m[2,0])/s, + (m[1,0] - m[0,1])/s, + ]) - return cls( np.array([w,x,y,z])/math.sqrt(w**2 + x**2 + y**2 + z**2)) + elif m[0,0] > m[1,1] and m[0,0] > m[2,2]: + t = m[0,0] - m[1,1] - m[2,2] + 1.0 + s = 2.0*math.sqrt(t) + + return cls( + [ (m[2,1] - m[1,2])/s, + s*0.25, + (m[0,1] + m[1,0])/s, + (m[2,0] + m[0,2])/s, + ]) + + elif m[1,1] > m[2,2]: + t = -m[0,0] + m[1,1] - m[2,2] + 1.0 + s = 2.0*math.sqrt(t) + + return cls( + [ (m[0,2] - m[2,0])/s, + (m[0,1] + m[1,0])/s, + s*0.25, + (m[1,2] + m[2,1])/s, + ]) + + else: + t = -m[0,0] - m[1,1] + m[2,2] + 1.0 + s = 2.0*math.sqrt(t) + + return cls( + [ (m[1,0] - m[0,1])/s, + (m[2,0] + m[0,2])/s, + (m[1,2] + m[2,1])/s, + s*0.25, + ]) @classmethod @@ -771,7 +829,7 @@ class Orientation: else: self.quaternion = Quaternion.fromRandom(randomSeed=random) elif isinstance(Eulers, np.ndarray) and Eulers.shape == (3,): # based on given Euler angles - self.quaternion = Quaternion.fromEulers(Eulers,degrees=degrees) + self.quaternion = Quaternion.fromEulers(Eulers,type='bunge',degrees=degrees) elif isinstance(matrix, np.ndarray) : # based on given rotation matrix self.quaternion = Quaternion.fromMatrix(matrix) elif isinstance(angleAxis, np.ndarray) and angleAxis.shape == (4,): # based on given angle and rotation axis @@ -797,15 +855,16 @@ class Orientation: return 'Symmetry: %s\n' % (self.symmetry) + \ 'Quaternion: %s\n' % (self.quaternion) + \ 'Matrix:\n%s\n' % ( '\n'.join(['\t'.join(map(str,self.asMatrix()[i,:])) for i in range(3)]) ) + \ - 'Bunge Eulers / deg: %s' % ('\t'.join(map(str,self.asEulers(degrees=True))) ) + 'Bunge Eulers / deg: %s' % ('\t'.join(map(str,self.asEulers('bunge',degrees=True))) ) def asQuaternion(self): return self.quaternion.asList() def asEulers(self, + type = 'bunge', degrees = False, - ): - return self.quaternion.asEulers(degrees) + standardRange = False): + return self.quaternion.asEulers(type, degrees, standardRange) eulers = property(asEulers) def asRodrigues(self):