did a lot of polishing:
- removed unnecessary "return" before end of subroutine or function: - changed undetermined array length (:) to (1:3) To prevent problems with some code analysing tools: - "3D oneliner loops" (with ";) only for "do" and "enddo" at the same time - removed line continuation in OMP statements made the makefile more flexible, removed heap-arrays switch
This commit is contained in:
Martin Diehl
parent
d235de1aa5
commit
c35ea33f8e
|
|
@ -152,7 +152,7 @@ program DAMASK_spectral
|
|||
print '(a,/,a)', 'Workingdir: ',trim(getSolverWorkingDirectoryName())
|
||||
print '(a,/,a)', 'SolverJobName: ',trim(getSolverJobName())
|
||||
|
||||
if (.not. IO_open_file(unit,path)) call IO_error(30,ext_msg = path)
|
||||
if (.not. IO_open_file(unit,path)) call IO_error(30,ext_msg = trim(path))
|
||||
|
||||
rewind(unit)
|
||||
do
|
||||
|
|
@ -181,7 +181,7 @@ program DAMASK_spectral
|
|||
|
||||
101 N_Loadcases = N_n
|
||||
if ((N_l + N_Fdot /= N_n) .or. (N_n /= N_t)) & ! sanity check
|
||||
call IO_error(31,ext_msg = path) ! error message for incomplete loadcase
|
||||
call IO_error(31,ext_msg = trim(path)) ! error message for incomplete loadcase
|
||||
|
||||
! allocate memory depending on lines in input file
|
||||
allocate (bc_deformation(3,3,N_Loadcases)); bc_deformation = 0.0_pReal
|
||||
|
|
@ -476,7 +476,7 @@ program DAMASK_spectral
|
|||
time = time + timeinc
|
||||
|
||||
if (velGradApplied(loadcase)) & ! calculate fDot from given L and current F
|
||||
fDot = math_mul33x33(bc_deformation(:,:,loadcase), defgradAim)
|
||||
fDot = math_mul33x33(bc_deformation(1:3,1:3,loadcase), defgradAim)
|
||||
|
||||
!winding forward of deformation aim
|
||||
temp33_Real = defgradAim
|
||||
|
|
@ -489,11 +489,11 @@ program DAMASK_spectral
|
|||
do k = 1, resolution(3); do j = 1, resolution(2); do i = 1, resolution(1)
|
||||
temp33_Real = defgrad(i,j,k,:,:)
|
||||
if (velGradApplied(loadcase)) & ! use velocity gradient to calculate new deformation gradient (if not guessing)
|
||||
fDot = math_mul33x33(bc_deformation(:,:,loadcase),defgradold(i,j,k,:,:))
|
||||
defgrad(i,j,k,:,:) = defgrad(i,j,k,:,:) & ! decide if guessing along former trajectory or apply homogeneous addon
|
||||
+ guessmode * (defgrad(i,j,k,:,:) - defgradold(i,j,k,:,:))& ! guessing...
|
||||
fDot = math_mul33x33(bc_deformation(1:3,1:3,loadcase),defgradold(i,j,k,1:3,1:3))
|
||||
defgrad(i,j,k,1:3,1:3) = defgrad(i,j,k,1:3,1:3) & ! decide if guessing along former trajectory or apply homogeneous addon
|
||||
+ guessmode * (defgrad(i,j,k,1:3,1:3) - defgradold(i,j,k,1:3,1:3))& ! guessing...
|
||||
+ (1.0_pReal-guessmode) * mask_defgrad * fDot *timeinc ! apply the prescribed value where deformation is given if not guessing
|
||||
defgradold(i,j,k,:,:) = temp33_Real
|
||||
defgradold(i,j,k,1:3,1:3) = temp33_Real
|
||||
enddo; enddo; enddo
|
||||
guessmode = 1.0_pReal ! keep guessing along former trajectory during same loadcase
|
||||
|
||||
|
|
|
|||
|
|
@ -190,7 +190,7 @@ function rectifyPath(path)
|
|||
!remove ./ from path
|
||||
l = len_trim(path)
|
||||
rectifyPath = path
|
||||
do i = l,2,-1
|
||||
do i = l,3,-1
|
||||
if ( rectifyPath(i-1:i) == './' .and. rectifyPath(i-2:i-2) /= '.' ) &
|
||||
rectifyPath(i-1:l) = rectifyPath(i+1:l)//' '
|
||||
enddo
|
||||
|
|
|
|||
|
|
@ -58,7 +58,6 @@ subroutine IO_init ()
|
|||
call flush(6)
|
||||
!$OMP END CRITICAL (write2out)
|
||||
|
||||
return
|
||||
endsubroutine
|
||||
|
||||
|
||||
|
|
@ -115,8 +114,7 @@ recursive function IO_abaqus_assembleInputFile(unit1,unit2) result(createSuccess
|
|||
return
|
||||
|
||||
200 createSuccess =.false.
|
||||
return
|
||||
|
||||
|
||||
end function
|
||||
|
||||
!***********************************************************
|
||||
|
|
@ -536,7 +534,7 @@ end function
|
|||
!********************************************************************
|
||||
! get tagged content of line
|
||||
!********************************************************************
|
||||
pure function IO_getTag (line,openChar,closechar)
|
||||
pure function IO_getTag (line,openChar,closeChar)
|
||||
|
||||
use prec, only: pInt
|
||||
implicit none
|
||||
|
|
@ -553,8 +551,6 @@ end function
|
|||
if (left == verify(line,sep) .and. right > left) & ! openChar is first and closeChar occurs
|
||||
IO_getTag = line(left+1:right-1)
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -805,7 +805,9 @@ if(updateJaco) then
|
|||
mySizeDotState = constitutive_sizeDotState(g,i,e)
|
||||
constitutive_state(g,i,e)%p(1:mySizeState) = constitutive_state_backup(g,i,e)%p(1:mySizeState)
|
||||
constitutive_dotState(g,i,e)%p(1:mySizeDotState) = constitutive_dotState_backup(g,i,e)%p(1:mySizeDotState)
|
||||
enddo; enddo; enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!OMP END PARALLEL DO
|
||||
crystallite_Temperature = Temperature_backup
|
||||
crystallite_subF = F_backup
|
||||
|
|
@ -842,8 +844,10 @@ if(updateJaco) then
|
|||
elseif (crystallite_requested(g,i,e) .and. .not. crystallite_converged(g,i,e)) then ! central solution did not converge
|
||||
crystallite_dPdF(1:3,1:3,1:3,1:3,g,i,e) = crystallite_fallbackdPdF(1:3,1:3,1:3,1:3,g,i,e) ! use (elastic) fallback
|
||||
endif
|
||||
enddo; enddo; enddo
|
||||
!OMP END PARALLEL DO
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
endif ! jacobian calculation
|
||||
|
||||
|
|
@ -2996,8 +3000,7 @@ logical error
|
|||
! --- UPDATE SOME ADDITIONAL VARIABLES THAT ARE NEEDED FOR NONLOCAL MATERIAL ---
|
||||
! --- we use crystallite_orientation from above, so need a seperate loop
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(myPhase,myInstance,myStructure,neighboring_e,neighboring_i, &
|
||||
!$OMP & neighboringPhase,neighboringInstance,neighboringStructure)
|
||||
!$OMP PARALLEL DO PRIVATE(myPhase,myInstance,myStructure,neighboring_e,neighboring_i,neighboringPhase,neighboringInstance,neighboringStructure)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
myPhase = material_phase(1,i,e) ! get my phase
|
||||
|
|
@ -3161,9 +3164,7 @@ function crystallite_postResults(&
|
|||
crystallite_Temperature(g,i,e), &
|
||||
dt, g, i, e)
|
||||
c = c + constitutive_sizePostResults(g,i,e)
|
||||
|
||||
return
|
||||
|
||||
|
||||
endfunction
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -219,8 +219,6 @@ subroutine homogenization_RGC_init(&
|
|||
! (6) Volume discrepancy, (7) Avg relaxation rate component, (8) Max relaxation rate component
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
||||
|
|
@ -238,8 +236,6 @@ function homogenization_RGC_stateInit(myInstance)
|
|||
!* Open a debugging file
|
||||
! open(1978,file='homogenization_RGC_debugging.out',status='unknown')
|
||||
homogenization_RGC_stateInit = 0.0_pReal
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
|
|
@ -319,8 +315,6 @@ subroutine homogenization_RGC_partitionDeformation(&
|
|||
endif
|
||||
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
@ -773,8 +767,6 @@ function homogenization_RGC_updateState(&
|
|||
|
||||
deallocate(tract,resid,jmatrix,jnverse,relax,drelax,pmatrix,smatrix,p_relax,p_resid)
|
||||
!*** End of calculation of state update
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
|
|
@ -815,7 +807,7 @@ subroutine homogenization_RGC_averageStressAndItsTangent(&
|
|||
if (debug_verbosity == 4) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
do iGrain = 1,Ngrains
|
||||
dPdF99 = math_Plain3333to99(dPdF(:,:,:,:,iGrain))
|
||||
dPdF99 = math_Plain3333to99(dPdF(1:3,1:3,1:3,1:3,iGrain))
|
||||
write(6,'(x,a30,x,i3)')'Stress tangent of grain: ',iGrain
|
||||
do i = 1,9
|
||||
write(6,'(x,(e14.8,x))') (dPdF99(i,j), j = 1,9)
|
||||
|
|
@ -830,8 +822,6 @@ subroutine homogenization_RGC_averageStressAndItsTangent(&
|
|||
avgP = sum(P,3)/dble(Ngrains)
|
||||
dAvgPdAvgF = sum(dPdF,5)/dble(Ngrains)
|
||||
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -858,8 +848,6 @@ function homogenization_RGC_averageTemperature(&
|
|||
Ngrains = homogenization_Ngrains(mesh_element(3,el))
|
||||
homogenization_RGC_averageTemperature = sum(Temperature(1:Ngrains))/dble(Ngrains)
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -915,8 +903,6 @@ pure function homogenization_RGC_postResults(&
|
|||
c = c + 1
|
||||
end select
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
|
|
@ -1051,8 +1037,6 @@ subroutine homogenization_RGC_stressPenalty(&
|
|||
enddo
|
||||
!*** End of mismatch and penalty stress tensor calculation
|
||||
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1112,8 +1096,6 @@ subroutine homogenization_RGC_volumePenalty(&
|
|||
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1159,8 +1141,6 @@ function homogenization_RGC_surfaceCorrection(&
|
|||
sqrt(homogenization_RGC_surfaceCorrection(iBase))*detF
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1196,8 +1176,6 @@ function homogenization_RGC_equivalentModuli(&
|
|||
!* Obtain the length of Burgers vector
|
||||
homogenization_RGC_equivalentModuli(2) = constitutive_averageBurgers(grainID,ip,el)
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1228,8 +1206,6 @@ function homogenization_RGC_relaxationVector(&
|
|||
if (iNum .gt. 0_pInt) homogenization_RGC_relaxationVector = state%p((3*iNum-2):(3*iNum))
|
||||
! get the corresponding entries
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1268,8 +1244,6 @@ function homogenization_RGC_interfaceNormal(&
|
|||
! call flush(6)
|
||||
! endif
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1297,8 +1271,6 @@ function homogenization_RGC_getInterface(&
|
|||
if (iDir < 0_pInt) & ! to have a correlation with coordinate/position in real space
|
||||
homogenization_RGC_getInterface(1_pInt-iDir) = homogenization_RGC_getInterface(1_pInt-iDir)-1_pInt
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1324,8 +1296,6 @@ function homogenization_RGC_grain1to3(&
|
|||
homogenization_RGC_grain1to3(2) = 1+mod((grain1-1)/nGDim(1),nGDim(2))
|
||||
homogenization_RGC_grain1to3(1) = 1+mod((grain1-1),nGDim(1))
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1350,8 +1320,6 @@ function homogenization_RGC_grain3to1(&
|
|||
nGDim = homogenization_RGC_Ngrains(:,homID)
|
||||
homogenization_RGC_grain3to1 = grain3(1) + nGDim(1)*(grain3(2)-1) + nGDim(1)*nGDim(2)*(grain3(3)-1)
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1393,8 +1361,6 @@ function homogenization_RGC_interface4to1(&
|
|||
if ((iFace4D(4) == 0_pInt) .or. (iFace4D(4) == nGDim(3))) homogenization_RGC_interface4to1 = 0_pInt
|
||||
endif
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1441,8 +1407,6 @@ function homogenization_RGC_interface1to4(&
|
|||
homogenization_RGC_interface1to4(4) = int(dble(iFace1D-nIntFace(2)-nIntFace(1)-1)/dble(nGDim(1))/dble(nGDim(2)))+1
|
||||
endif
|
||||
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1492,8 +1456,6 @@ subroutine homogenization_RGC_grainDeformation(&
|
|||
enddo
|
||||
F(:,:,iGrain) = F(:,:,iGrain) + avgF(:,:) ! relaxed deformation gradient
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
|
|||
|
|
@ -811,7 +811,6 @@ function lattice_initializeStructure(struct,CoverA)
|
|||
logical :: processMe
|
||||
|
||||
integer(pInt) lattice_initializeStructure
|
||||
|
||||
processMe = .false.
|
||||
|
||||
select case(struct(1:3)) ! check first three chars of structure name
|
||||
|
|
@ -825,14 +824,14 @@ function lattice_initializeStructure(struct,CoverA)
|
|||
if (lattice_fcc_Nstructure == 1_pInt) then ! me is first fcc structure
|
||||
processMe = .true.
|
||||
do i = 1,myNslip ! calculate slip system vectors
|
||||
sd(:,i) = lattice_fcc_systemSlip(1:3,i)/sqrt(math_mul3x3(lattice_fcc_systemSlip(1:3,i),lattice_fcc_systemSlip(1:3,i)))
|
||||
sn(:,i) = lattice_fcc_systemSlip(4:6,i)/sqrt(math_mul3x3(lattice_fcc_systemSlip(4:6,i),lattice_fcc_systemSlip(4:6,i)))
|
||||
st(:,i) = math_vectorproduct(sd(:,i),sn(:,i))
|
||||
sd(1:3,i) = lattice_fcc_systemSlip(1:3,i)/sqrt(math_mul3x3(lattice_fcc_systemSlip(1:3,i),lattice_fcc_systemSlip(1:3,i)))
|
||||
sn(1:3,i) = lattice_fcc_systemSlip(4:6,i)/sqrt(math_mul3x3(lattice_fcc_systemSlip(4:6,i),lattice_fcc_systemSlip(4:6,i)))
|
||||
st(1:3,i) = math_vectorproduct(sd(1:3,i),sn(1:3,i))
|
||||
enddo
|
||||
do i = 1,myNtwin ! calculate twin system vectors and (assign) shears
|
||||
td(:,i) = lattice_fcc_systemTwin(1:3,i)/sqrt(math_mul3x3(lattice_fcc_systemTwin(1:3,i),lattice_fcc_systemTwin(1:3,i)))
|
||||
tn(:,i) = lattice_fcc_systemTwin(4:6,i)/sqrt(math_mul3x3(lattice_fcc_systemTwin(4:6,i),lattice_fcc_systemTwin(4:6,i)))
|
||||
tt(:,i) = math_vectorproduct(td(:,i),tn(:,i))
|
||||
td(1:3,i) = lattice_fcc_systemTwin(1:3,i)/sqrt(math_mul3x3(lattice_fcc_systemTwin(1:3,i),lattice_fcc_systemTwin(1:3,i)))
|
||||
tn(1:3,i) = lattice_fcc_systemTwin(4:6,i)/sqrt(math_mul3x3(lattice_fcc_systemTwin(4:6,i),lattice_fcc_systemTwin(4:6,i)))
|
||||
tt(1:3,i) = math_vectorproduct(td(1:3,i),tn(1:3,i))
|
||||
ts(i) = lattice_fcc_shearTwin(i)
|
||||
enddo
|
||||
interactionSlipSlip => lattice_fcc_interactionSlipSlip
|
||||
|
|
@ -851,14 +850,14 @@ function lattice_initializeStructure(struct,CoverA)
|
|||
if (lattice_bcc_Nstructure == 1_pInt) then ! me is first bcc structure
|
||||
processMe = .true.
|
||||
do i = 1,myNslip ! calculate slip system vectors
|
||||
sd(:,i) = lattice_bcc_systemSlip(1:3,i)/sqrt(math_mul3x3(lattice_bcc_systemSlip(1:3,i),lattice_bcc_systemSlip(1:3,i)))
|
||||
sn(:,i) = lattice_bcc_systemSlip(4:6,i)/sqrt(math_mul3x3(lattice_bcc_systemSlip(4:6,i),lattice_bcc_systemSlip(4:6,i)))
|
||||
st(:,i) = math_vectorproduct(sd(:,i),sn(:,i))
|
||||
sd(1:3,i) = lattice_bcc_systemSlip(1:3,i)/sqrt(math_mul3x3(lattice_bcc_systemSlip(1:3,i),lattice_bcc_systemSlip(1:3,i)))
|
||||
sn(1:3,i) = lattice_bcc_systemSlip(4:6,i)/sqrt(math_mul3x3(lattice_bcc_systemSlip(4:6,i),lattice_bcc_systemSlip(4:6,i)))
|
||||
st(1:3,i) = math_vectorproduct(sd(1:3,i),sn(1:3,i))
|
||||
enddo
|
||||
do i = 1,myNtwin ! calculate twin system vectors and (assign) shears
|
||||
td(:,i) = lattice_bcc_systemTwin(1:3,i)/sqrt(math_mul3x3(lattice_bcc_systemTwin(1:3,i),lattice_bcc_systemTwin(1:3,i)))
|
||||
tn(:,i) = lattice_bcc_systemTwin(4:6,i)/sqrt(math_mul3x3(lattice_bcc_systemTwin(4:6,i),lattice_bcc_systemTwin(4:6,i)))
|
||||
tt(:,i) = math_vectorproduct(td(:,i),tn(:,i))
|
||||
td(1:3,i) = lattice_bcc_systemTwin(1:3,i)/sqrt(math_mul3x3(lattice_bcc_systemTwin(1:3,i),lattice_bcc_systemTwin(1:3,i)))
|
||||
tn(1:3,i) = lattice_bcc_systemTwin(4:6,i)/sqrt(math_mul3x3(lattice_bcc_systemTwin(4:6,i),lattice_bcc_systemTwin(4:6,i)))
|
||||
tt(1:3,i) = math_vectorproduct(td(1:3,i),tn(1:3,i))
|
||||
ts(i) = lattice_bcc_shearTwin(i)
|
||||
enddo
|
||||
interactionSlipSlip => lattice_bcc_interactionSlipSlip
|
||||
|
|
@ -885,9 +884,9 @@ function lattice_initializeStructure(struct,CoverA)
|
|||
hex_n(2) = (lattice_hex_systemSlip(5,i)+2.0_pReal*lattice_hex_systemSlip(6,i))/sqrt(3.0_pReal)
|
||||
hex_n(3) = lattice_hex_systemSlip(8,i)/CoverA
|
||||
|
||||
sd(:,i) = hex_d/sqrt(math_mul3x3(hex_d,hex_d))
|
||||
sn(:,i) = hex_n/sqrt(math_mul3x3(hex_n,hex_n))
|
||||
st(:,i) = math_vectorproduct(sd(:,i),sn(:,i))
|
||||
sd(1:3,i) = hex_d/sqrt(math_mul3x3(hex_d,hex_d))
|
||||
sn(1:3,i) = hex_n/sqrt(math_mul3x3(hex_n,hex_n))
|
||||
st(1:3,i) = math_vectorproduct(sd(1:3,i),sn(1:3,i))
|
||||
enddo
|
||||
do i = 1,myNtwin
|
||||
hex_d(1) = lattice_hex_systemTwin(1,i)*1.5_pReal
|
||||
|
|
@ -897,9 +896,9 @@ function lattice_initializeStructure(struct,CoverA)
|
|||
hex_n(2) = (lattice_hex_systemTwin(5,i)+2.0_pReal*lattice_hex_systemTwin(6,i))/sqrt(3.0_pReal)
|
||||
hex_n(3) = lattice_hex_systemTwin(8,i)/CoverA
|
||||
|
||||
td(:,i) = hex_d/sqrt(math_mul3x3(hex_d,hex_d))
|
||||
tn(:,i) = hex_n/sqrt(math_mul3x3(hex_n,hex_n))
|
||||
tt(:,i) = math_vectorproduct(td(:,i),tn(:,i))
|
||||
td(1:3,i) = hex_d/sqrt(math_mul3x3(hex_d,hex_d))
|
||||
tn(1:3,i) = hex_n/sqrt(math_mul3x3(hex_n,hex_n))
|
||||
tt(1:3,i) = math_vectorproduct(td(1:3,i),tn(1:3,i))
|
||||
|
||||
select case(lattice_hex_shearTwin(i)) ! from Christian & Mahajan 1995 p.29
|
||||
case (1) ! {10.2}<-10.1>
|
||||
|
|
@ -924,19 +923,19 @@ function lattice_initializeStructure(struct,CoverA)
|
|||
if (myStructure > lattice_Nstructure) &
|
||||
call IO_error(666,0,0,0,'structure index too large') ! check for memory leakage
|
||||
do i = 1,myNslip ! store slip system vectors and Schmid matrix for my structure
|
||||
lattice_sd(:,i,myStructure) = sd(:,i)
|
||||
lattice_st(:,i,myStructure) = st(:,i)
|
||||
lattice_sn(:,i,myStructure) = sn(:,i)
|
||||
lattice_Sslip(:,:,i,myStructure) = math_tensorproduct(sd(:,i),sn(:,i))
|
||||
lattice_Sslip_v(:,i,myStructure) = math_Mandel33to6(math_symmetric3x3(lattice_Sslip(:,:,i,myStructure)))
|
||||
lattice_sd(1:3,i,myStructure) = sd(1:3,i)
|
||||
lattice_st(1:3,i,myStructure) = st(1:3,i)
|
||||
lattice_sn(1:3,i,myStructure) = sn(1:3,i)
|
||||
lattice_Sslip(1:3,1:3,i,myStructure) = math_tensorproduct(sd(1:3,i),sn(1:3,i))
|
||||
lattice_Sslip_v(1:6,i,myStructure) = math_Mandel33to6(math_symmetric3x3(lattice_Sslip(1:3,1:3,i,myStructure)))
|
||||
enddo
|
||||
do i = 1,myNtwin ! store twin system vectors and Schmid plus rotation matrix for my structure
|
||||
lattice_td(:,i,myStructure) = td(:,i)
|
||||
lattice_tt(:,i,myStructure) = tt(:,i)
|
||||
lattice_tn(:,i,myStructure) = tn(:,i)
|
||||
lattice_Stwin(:,:,i,myStructure) = math_tensorproduct(td(:,i),tn(:,i))
|
||||
lattice_Stwin_v(:,i,myStructure) = math_Mandel33to6(math_symmetric3x3(lattice_Stwin(:,:,i,myStructure)))
|
||||
lattice_Qtwin(:,:,i,myStructure) = math_AxisAngleToR(tn(:,i),180.0_pReal*inRad)
|
||||
lattice_td(1:3,i,myStructure) = td(1:3,i)
|
||||
lattice_tt(1:3,i,myStructure) = tt(1:3,i)
|
||||
lattice_tn(1:3,i,myStructure) = tn(1:3,i)
|
||||
lattice_Stwin(1:3,1:3,i,myStructure) = math_tensorproduct(td(1:3,i),tn(1:3,i))
|
||||
lattice_Stwin_v(1:6,i,myStructure) = math_Mandel33to6(math_symmetric3x3(lattice_Stwin(1:3,1:3,i,myStructure)))
|
||||
lattice_Qtwin(1:3,1:3,i,myStructure) = math_AxisAngleToR(tn(1:3,i),180.0_pReal*inRad)
|
||||
lattice_shearTwin(i,myStructure) = ts(i)
|
||||
enddo
|
||||
lattice_NslipSystem(1:lattice_maxNslipFamily,myStructure) = myNslipSystem ! number of slip systems in each family
|
||||
|
|
|
|||
100
code/makefile
100
code/makefile
|
|
@ -10,7 +10,7 @@
|
|||
# Install fftw3 (v3.2.2 is tested) with "./configure --enable-threads --enable-float" and "make", "make install" is not needed
|
||||
# as long as the two library files are copied to the source code directory.
|
||||
|
||||
# OPTIONS = standart (alternative): meaning
|
||||
# OPTIONS = standard (alternative): meaning
|
||||
#-------------------------------------------------------------
|
||||
# PRECISION = double (single): floating point precision
|
||||
# F90 = ifort (gfortran): compiler, choose Intel or GNU
|
||||
|
|
@ -19,6 +19,25 @@
|
|||
# OPTIMIZATION = DEFENSIVE (OFF,AGGRESSIVE): Optimization mode, O0, O2, O3
|
||||
# OPENMP = TRUE (FALSE): OpenMP multiprocessor support
|
||||
# ACML = OFF (ON): link with AMD math core library (v. 4.4 need to be installed)
|
||||
# PREFIX: specifie an arbitrary prefix
|
||||
# COMPILERNAME = overwrite name of Compiler, e.g. using mpich-g90 instead of ifort
|
||||
|
||||
# Here are some usefull debugging switches. Switch on by uncommenting last line:
|
||||
#--------------------------------------------------------------------------------
|
||||
# information on http://software.intel.com/en-us/articles/determining-root-cause-of-sigsegv-or-sigbus-errors/
|
||||
# check if an array index is too small (<1) or too large!
|
||||
DEBUG1 =-check bounds -g
|
||||
#will cause a lot of warnings because we create a bunch of temporary arrays
|
||||
DEBUG2 =-check arg_temp_created
|
||||
#check from time to time
|
||||
DEBUG3 =-fp-stack-check -g -traceback -gen-interfaces -warn interfaces
|
||||
|
||||
#should not be done for OpenMP, but set "ulimit -s unlimited" on shell. Porblably it helps to also unlimit other limits
|
||||
DEBUG4 =-heap-arrays
|
||||
|
||||
#SUFFIX =$(DEBUG1) $(DEBUG2) $(DEBUG3)
|
||||
#SUFFIX =$(DEBUG1) $(DEBUG3)
|
||||
|
||||
|
||||
ifeq ($(F90), )
|
||||
F90 =ifort
|
||||
|
|
@ -43,7 +62,7 @@ endif
|
|||
endif
|
||||
|
||||
ifneq ($(OPENMP), OFF)
|
||||
OPENMP_FLAG_ifort =-openmp
|
||||
OPENMP_FLAG_ifort =-openmp -openmp-report0 -parallel
|
||||
OPENMP_FLAG_gfortran =-fopenmp
|
||||
OPENMP =ON
|
||||
endif
|
||||
|
|
@ -59,49 +78,46 @@ OPTIMIZATION_OFF_ifort =-O0
|
|||
OPTIMIZATION_OFF_gfortran =-O0
|
||||
OPTIMIZATION_DEFENSIVE_ifort =-O2
|
||||
OPTIMIZATION_DEFENSIVE_gfortran =-O2
|
||||
OPTIMIZATION_AGGRESSIVE_ifort =-O3 -static $(PORTABLE_SWITCH)
|
||||
OPTIMIZATION_AGGRESSIVE_ifort =-O3 $(PORTABLE_SWITCH) -ip
|
||||
OPTIMIZATION_AGGRESSIVE_gfortran =-O3
|
||||
|
||||
COMPILE_OPTIONS_ifort =-fpp -diag-disable 8291,8290
|
||||
COMPILE_OPTIONS_gfortran =-xf95-cpp-input
|
||||
|
||||
HEAP_ARRAYS_ifort =-heap-arrays 500000000
|
||||
HEAP_ARRAYS_gfortran =
|
||||
|
||||
COMPILE_OPTIONS_ifort =-fpp -diag-disable 8291,8290
|
||||
COMPILE_OPTIONS_gfortran =-xf95-cpp-input -ffree-line-length-none
|
||||
|
||||
COMPILE =${OPENMP_FLAG_${F90}} ${COMPILE_OPTIONS_${F90}} ${OPTIMIZATION_${OPTIMIZATION}_${F90}} -c
|
||||
COMPILE_HEAP =$(COMPILE) ${HEAP_ARRAYS_${F90}}
|
||||
COMPILE_HEAP_MAXOPTI =${OPENMP_FLAG_${F90}} ${COMPILE_OPTIONS_${F90}} ${OPTIMIZATION_${MAXOPTI}_${F90}} ${HEAP_ARRAYS_${F90}} -c
|
||||
COMPILE_MAXOPTI =${OPENMP_FLAG_${F90}} ${COMPILE_OPTIONS_${F90}} ${OPTIMIZATION_${MAXOPTI}_${F90}} -c
|
||||
|
||||
ifndef COMPILERNAME
|
||||
COMPILERNAME=$(F90)
|
||||
endif
|
||||
|
||||
|
||||
ifeq ($(PRECISION),single)
|
||||
DAMASK_spectral_single.exe: DAMASK_spectral_single.o CPFEM.a
|
||||
$(F90) ${OPENMP_FLAG_${F90}} -o DAMASK_spectral_single.exe DAMASK_spectral_single.o CPFEM.a include/libfftw3f_threads.a include/libfftw3f.a constitutive.a advanced.a basics.a\
|
||||
-lpthread ${BLAS_${OPENMP}_${F90}}
|
||||
$(PREFIX) $(COMPILERNAME) ${OPENMP_FLAG_${F90}} -o DAMASK_spectral_single.exe DAMASK_spectral_single.o CPFEM.a include/libfftw3f_threads.a include/libfftw3f.a\
|
||||
constitutive.a advanced.a basics.a -lpthread ${BLAS_${OPENMP}_${F90}}
|
||||
DAMASK_spectral_single.o: DAMASK_spectral_single.f90 CPFEM.o
|
||||
$(F90) $(COMPILE_HEAP_MAXOPTI) DAMASK_spectral_single.f90
|
||||
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE_MAXOPTI) DAMASK_spectral_single.f90 $(SUFFIX)
|
||||
else
|
||||
DAMASK_spectral.exe: DAMASK_spectral.o CPFEM.a
|
||||
$(F90) ${OPENMP_FLAG_${F90}} -o DAMASK_spectral.exe DAMASK_spectral.o CPFEM.a include/libfftw3_threads.a include/libfftw3.a constitutive.a advanced.a basics.a\
|
||||
-lpthread ${BLAS_${OPENMP}_${F90}}
|
||||
$(PREFIX) $(COMPILERNAME) ${OPENMP_FLAG_${F90}} -o DAMASK_spectral.exe DAMASK_spectral.o CPFEM.a include/libfftw3_threads.a include/libfftw3.a\
|
||||
constitutive.a advanced.a basics.a -lpthread ${BLAS_${OPENMP}_${F90}}
|
||||
DAMASK_spectral.o: DAMASK_spectral.f90 CPFEM.o
|
||||
$(F90) $(COMPILE_HEAP_MAXOPTI) DAMASK_spectral.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE_MAXOPTI) DAMASK_spectral.f90 $(SUFFIX)
|
||||
endif
|
||||
|
||||
CPFEM.a: CPFEM.o
|
||||
ar rc CPFEM.a homogenization.o homogenization_RGC.o homogenization_isostrain.o crystallite.o CPFEM.o constitutive.o
|
||||
|
||||
CPFEM.o: CPFEM.f90 homogenization.o
|
||||
$(F90) $(COMPILE_HEAP) CPFEM.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) CPFEM.f90 $(SUFFIX)
|
||||
homogenization.o: homogenization.f90 homogenization_isostrain.o homogenization_RGC.o crystallite.o
|
||||
$(F90) $(COMPILE_HEAP) homogenization.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) homogenization.f90 $(SUFFIX)
|
||||
homogenization_RGC.o: homogenization_RGC.f90 constitutive.a
|
||||
$(F90) $(COMPILE_HEAP) homogenization_RGC.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) homogenization_RGC.f90 $(SUFFIX)
|
||||
homogenization_isostrain.o: homogenization_isostrain.f90 basics.a advanced.a
|
||||
$(F90) $(COMPILE_HEAP) homogenization_isostrain.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) homogenization_isostrain.f90 $(SUFFIX)
|
||||
crystallite.o: crystallite.f90 constitutive.a
|
||||
$(F90) $(COMPILE_HEAP) crystallite.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) crystallite.f90 $(SUFFIX)
|
||||
|
||||
|
||||
|
||||
|
|
@ -109,22 +125,22 @@ constitutive.a: constitutive.o
|
|||
ar rc constitutive.a constitutive.o constitutive_titanmod.o constitutive_nonlocal.o constitutive_dislotwin.o constitutive_j2.o constitutive_phenopowerlaw.o basics.a advanced.a
|
||||
|
||||
constitutive.o: constitutive.f90 constitutive_titanmod.o constitutive_nonlocal.o constitutive_dislotwin.o constitutive_j2.o constitutive_phenopowerlaw.o
|
||||
$(F90) $(COMPILE_HEAP) constitutive.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive.f90 $(SUFFIX)
|
||||
|
||||
constitutive_titanmod.o: constitutive_titanmod.f90 basics.a advanced.a
|
||||
$(F90) $(COMPILE_HEAP) constitutive_titanmod.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive_titanmod.f90 $(SUFFIX)
|
||||
|
||||
constitutive_nonlocal.o: constitutive_nonlocal.f90 basics.a advanced.a
|
||||
$(F90) $(COMPILE_HEAP) constitutive_nonlocal.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive_nonlocal.f90 $(SUFFIX)
|
||||
|
||||
constitutive_dislotwin.o: constitutive_dislotwin.f90 basics.a advanced.a
|
||||
$(F90) $(COMPILE_HEAP) constitutive_dislotwin.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive_dislotwin.f90 $(SUFFIX)
|
||||
|
||||
constitutive_j2.o: constitutive_j2.f90 basics.a advanced.a
|
||||
$(F90) $(COMPILE_HEAP) constitutive_j2.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive_j2.f90 $(SUFFIX)
|
||||
|
||||
constitutive_phenopowerlaw.o: constitutive_phenopowerlaw.f90 basics.a advanced.a
|
||||
$(F90) $(COMPILE_HEAP) constitutive_phenopowerlaw.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) constitutive_phenopowerlaw.f90 $(SUFFIX)
|
||||
|
||||
|
||||
|
||||
|
|
@ -133,13 +149,13 @@ advanced.a: lattice.o
|
|||
|
||||
|
||||
lattice.o: lattice.f90 material.o
|
||||
$(F90) $(COMPILE_HEAP) lattice.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) lattice.f90 $(SUFFIX)
|
||||
material.o: material.f90 mesh.o
|
||||
$(F90) $(COMPILE_HEAP) material.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) material.f90 $(SUFFIX)
|
||||
mesh.o: mesh.f90 FEsolving.o
|
||||
$(F90) $(COMPILE_HEAP) mesh.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) mesh.f90 $(SUFFIX)
|
||||
FEsolving.o: FEsolving.f90 basics.a
|
||||
$(F90) $(COMPILE_HEAP) FEsolving.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) FEsolving.f90 $(SUFFIX)
|
||||
|
||||
ifeq ($(PRECISION),single)
|
||||
basics.a: debug.o math.o
|
||||
|
|
@ -150,25 +166,25 @@ basics.a: debug.o math.o
|
|||
endif
|
||||
|
||||
debug.o: debug.f90 numerics.o
|
||||
$(F90) $(COMPILE) debug.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) debug.f90 $(SUFFIX)
|
||||
math.o: math.f90 numerics.o
|
||||
$(F90) $(COMPILE) math.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) math.f90 $(SUFFIX)
|
||||
|
||||
numerics.o: numerics.f90 IO.o
|
||||
$(F90) $(COMPILE) numerics.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) numerics.f90 $(SUFFIX)
|
||||
IO.o: IO.f90 DAMASK_spectral_interface.o
|
||||
$(F90) $(COMPILE) IO.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) IO.f90 $(SUFFIX)
|
||||
|
||||
ifeq ($(PRECISION),single)
|
||||
DAMASK_spectral_interface.o: DAMASK_spectral_interface.f90 prec_single.o
|
||||
$(F90) $(COMPILE) DAMASK_spectral_interface.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) DAMASK_spectral_interface.f90 $(SUFFIX)
|
||||
prec_single.o: prec_single.f90
|
||||
$(F90) $(COMPILE) prec_single.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) prec_single.f90 $(SUFFIX)
|
||||
else
|
||||
DAMASK_spectral_interface.o: DAMASK_spectral_interface.f90 prec.o
|
||||
$(F90) $(COMPILE) DAMASK_spectral_interface.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) DAMASK_spectral_interface.f90 $(SUFFIX)
|
||||
prec.o: prec.f90
|
||||
$(F90) $(COMPILE) prec.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) prec.f90 $(SUFFIX)
|
||||
endif
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -245,7 +245,6 @@ subroutine material_parseHomogenization(file,myPart)
|
|||
enddo
|
||||
|
||||
100 homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active)
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
@ -266,7 +265,7 @@ subroutine material_parseMicrostructure(file,myPart)
|
|||
integer(pInt) Nsections, section, constituent, i
|
||||
character(len=64) tag
|
||||
character(len=1024) line
|
||||
|
||||
|
||||
Nsections = IO_countSections(file,myPart)
|
||||
material_Nmicrostructure = Nsections
|
||||
if (Nsections < 1_pInt) call IO_error(125,ext_msg=myPart)
|
||||
|
|
@ -799,8 +798,6 @@ subroutine material_populateGrains()
|
|||
deallocate(phaseOfGrain)
|
||||
deallocate(textureOfGrain)
|
||||
deallocate(orientationOfGrain)
|
||||
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
|
|||
|
|
@ -449,7 +449,6 @@
|
|||
exit
|
||||
endif
|
||||
enddo
|
||||
return
|
||||
|
||||
endfunction
|
||||
|
||||
|
|
@ -1353,8 +1352,6 @@ FE_ipNeighbor(:FE_NipNeighbors(8),:FE_Nips(8),8) = & ! element 117
|
|||
6, 7, 7, 6 &
|
||||
/),(/FE_NipFaceNodes,FE_NipNeighbors(10),FE_Nips(10)/))
|
||||
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
||||
|
|
@ -1392,9 +1389,7 @@ FE_ipNeighbor(:FE_NipNeighbors(8),:FE_Nips(8),8) = & ! element 117
|
|||
endif
|
||||
enddo
|
||||
|
||||
620 return
|
||||
|
||||
endsubroutine
|
||||
620 endsubroutine
|
||||
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1441,9 +1436,7 @@ do
|
|||
endif
|
||||
enddo
|
||||
|
||||
620 return
|
||||
|
||||
endsubroutine
|
||||
620 endsubroutine
|
||||
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1490,9 +1483,7 @@ endsubroutine
|
|||
endif
|
||||
enddo
|
||||
|
||||
100 return
|
||||
|
||||
endsubroutine
|
||||
100 endsubroutine
|
||||
|
||||
!********************************************************************
|
||||
! count overall number of nodes and elements in mesh
|
||||
|
|
@ -1528,9 +1519,7 @@ endsubroutine
|
|||
endif
|
||||
enddo
|
||||
|
||||
620 return
|
||||
|
||||
endsubroutine
|
||||
620 endsubroutine
|
||||
|
||||
!********************************************************************
|
||||
! count overall number of nodes and elements in mesh
|
||||
|
|
@ -1588,8 +1577,6 @@ endsubroutine
|
|||
|
||||
620 if (mesh_Nnodes < 2) call IO_error(900)
|
||||
if (mesh_Nelems == 0) call IO_error(901)
|
||||
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
@ -1629,9 +1616,7 @@ endsubroutine
|
|||
endif
|
||||
enddo
|
||||
|
||||
620 return
|
||||
|
||||
endsubroutine
|
||||
620 endsubroutine
|
||||
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1673,7 +1658,6 @@ endsubroutine
|
|||
620 continue
|
||||
if (mesh_NelemSets == 0) call IO_error(902)
|
||||
|
||||
return
|
||||
endsubroutine
|
||||
|
||||
|
||||
|
|
@ -1716,7 +1700,6 @@ endsubroutine
|
|||
|
||||
620 if (mesh_Nmaterials == 0) call IO_error(903)
|
||||
|
||||
return
|
||||
endsubroutine
|
||||
|
||||
|
||||
|
|
@ -1731,7 +1714,6 @@ endsubroutine
|
|||
implicit none
|
||||
|
||||
mesh_NcpElems = mesh_Nelems
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
@ -1771,9 +1753,7 @@ endsubroutine
|
|||
endif
|
||||
enddo
|
||||
|
||||
620 return
|
||||
|
||||
endsubroutine
|
||||
620 endsubroutine
|
||||
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1825,7 +1805,6 @@ endsubroutine
|
|||
|
||||
620 if (mesh_NcpElems == 0) call IO_error(906)
|
||||
|
||||
return
|
||||
endsubroutine
|
||||
|
||||
|
||||
|
|
@ -1865,9 +1844,7 @@ endsubroutine
|
|||
endif
|
||||
enddo
|
||||
|
||||
640 return
|
||||
|
||||
endsubroutine
|
||||
640 endsubroutine
|
||||
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -1917,7 +1894,6 @@ endsubroutine
|
|||
if (mesh_mapElemSet(1,i) == 0) call IO_error(ID=904,ext_msg=mesh_nameElemSet(i))
|
||||
enddo
|
||||
|
||||
return
|
||||
endsubroutine
|
||||
|
||||
|
||||
|
|
@ -1984,7 +1960,6 @@ endsubroutine
|
|||
if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(905)
|
||||
enddo
|
||||
|
||||
return
|
||||
endsubroutine
|
||||
|
||||
|
||||
|
|
@ -2004,9 +1979,7 @@ endsubroutine
|
|||
allocate (mesh_mapFEtoCPnode(2,mesh_Nnodes)) ; mesh_mapFEtoCPnode = 0_pInt
|
||||
|
||||
forall (i = 1:mesh_Nnodes) &
|
||||
mesh_mapFEtoCPnode(:,i) = i
|
||||
|
||||
return
|
||||
mesh_mapFEtoCPnode(1:2,i) = i
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
@ -2054,8 +2027,6 @@ endsubroutine
|
|||
enddo
|
||||
|
||||
650 call qsort(mesh_mapFEtoCPnode,1,size(mesh_mapFEtoCPnode,2))
|
||||
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
@ -2119,7 +2090,6 @@ endsubroutine
|
|||
650 call qsort(mesh_mapFEtoCPnode,1,size(mesh_mapFEtoCPnode,2))
|
||||
|
||||
if (size(mesh_mapFEtoCPnode) == 0) call IO_error(908)
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
@ -2139,9 +2109,7 @@ endsubroutine
|
|||
allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems)) ; mesh_mapFEtoCPelem = 0_pInt
|
||||
|
||||
forall (i = 1:mesh_NcpElems) &
|
||||
mesh_mapFEtoCPelem(:,i) = i
|
||||
|
||||
return
|
||||
mesh_mapFEtoCPelem(1:2,i) = i
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
@ -2191,7 +2159,6 @@ endsubroutine
|
|||
|
||||
660 call qsort(mesh_mapFEtoCPelem,1,size(mesh_mapFEtoCPelem,2)) ! should be mesh_NcpElems
|
||||
|
||||
return
|
||||
endsubroutine
|
||||
|
||||
|
||||
|
|
@ -2253,8 +2220,7 @@ endsubroutine
|
|||
660 call qsort(mesh_mapFEtoCPelem,1,size(mesh_mapFEtoCPelem,2)) ! should be mesh_NcpElems
|
||||
|
||||
if (size(mesh_mapFEtoCPelem) < 2) call IO_error(907)
|
||||
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
||||
|
|
@ -2328,8 +2294,7 @@ subroutine mesh_marc_count_cpSizes (unit)
|
|||
endif
|
||||
enddo
|
||||
|
||||
630 return
|
||||
endsubroutine
|
||||
630 endsubroutine
|
||||
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -2392,9 +2357,7 @@ subroutine mesh_marc_count_cpSizes (unit)
|
|||
endif
|
||||
enddo
|
||||
|
||||
620 return
|
||||
|
||||
endsubroutine
|
||||
620 endsubroutine
|
||||
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -2483,9 +2446,7 @@ subroutine mesh_marc_count_cpSizes (unit)
|
|||
|
||||
mesh_node = mesh_node0
|
||||
|
||||
100 return
|
||||
|
||||
endsubroutine
|
||||
100 endsubroutine
|
||||
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -2528,7 +2489,6 @@ subroutine mesh_marc_count_cpSizes (unit)
|
|||
enddo
|
||||
|
||||
670 mesh_node = mesh_node0
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
@ -2588,7 +2548,6 @@ return
|
|||
|
||||
670 if (size(mesh_node0,2) /= mesh_Nnodes) call IO_error(909)
|
||||
mesh_node = mesh_node0
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
@ -2676,9 +2635,7 @@ return
|
|||
mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e))
|
||||
enddo
|
||||
|
||||
110 return
|
||||
|
||||
endsubroutine
|
||||
110 endsubroutine
|
||||
|
||||
|
||||
|
||||
|
|
@ -2762,9 +2719,7 @@ return
|
|||
endif
|
||||
enddo
|
||||
|
||||
630 return
|
||||
|
||||
endsubroutine
|
||||
630 endsubroutine
|
||||
|
||||
|
||||
|
||||
|
|
@ -2867,9 +2822,7 @@ return
|
|||
endselect
|
||||
enddo
|
||||
|
||||
630 return
|
||||
|
||||
endsubroutine
|
||||
630 endsubroutine
|
||||
|
||||
|
||||
!********************************************************************
|
||||
|
|
@ -3247,7 +3200,6 @@ endsubroutine
|
|||
|
||||
allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) ; mesh_ipArea = 0.0_pReal
|
||||
allocate(mesh_ipAreaNormal(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) ; mesh_ipAreaNormal = 0.0_pReal
|
||||
|
||||
do e = 1,mesh_NcpElems ! loop over cpElems
|
||||
t = mesh_element(2,e) ! get elemType
|
||||
do i = 1,FE_Nips(t) ! loop over IPs of elem
|
||||
|
|
@ -3259,14 +3211,13 @@ endsubroutine
|
|||
area(j,n) = sqrt(sum(normal(:,j,n)*normal(:,j,n))) ! and area
|
||||
end forall
|
||||
forall (n = 1:FE_NipFaceNodes, j = 1:Ntriangles, area(j,n) > 0.0_pReal) &
|
||||
normal(:,j,n) = normal(:,j,n) / area(j,n) ! make unit normal
|
||||
normal(1:3,j,n) = normal(1:3,j,n) / area(j,n) ! make unit normal
|
||||
|
||||
mesh_ipArea(f,i,e) = sum(area) / (FE_NipFaceNodes*2.0_pReal) ! area of parallelograms instead of triangles
|
||||
mesh_ipAreaNormal(:,f,i,e) = sum(sum(normal,3),2) / count(area > 0.0_pReal) ! average of all valid normals
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
return
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
|
@ -3399,11 +3350,11 @@ if (debug_verbosity > 0) then
|
|||
write (6,*) mesh_maxValStateVar(1), " : maximum homogenization index"
|
||||
write (6,*) mesh_maxValStateVar(2), " : maximum microstructure index"
|
||||
write (6,*)
|
||||
write (fmt,"(a,i5,a)") "(9(x),a2,x,",mesh_maxValStateVar(2),"(i8))"
|
||||
write (fmt,"(a,i32.32,a)") "(9(x),a2,x,",mesh_maxValStateVar(2),"(i8))"
|
||||
write (6,fmt) "+-",math_range(mesh_maxValStateVar(2))
|
||||
write (fmt,"(a,i5,a)") "(i8,x,a2,x,",mesh_maxValStateVar(2),"(i8))"
|
||||
write (fmt,"(a,i32.32,a)") "(i8,x,a2,x,",mesh_maxValStateVar(2),"(i8))"
|
||||
do i=1,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations
|
||||
write (6,fmt) i,"| ",mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstrcutures
|
||||
write (6,fmt) i,"| ",mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures
|
||||
enddo
|
||||
write(6,*)
|
||||
write(6,*) "Input Parser: ADDITIONAL MPIE OPTIONS"
|
||||
|
|
|
|||
Loading…
Reference in New Issue