Mechanics.Of.Materials.Saouma Episode 14 ppsx

INTEGER fid [REFERENCE]INTEGER stg_len [REFERENCE] CHARACTER*80 string [REFERENCE] END SUBROUTINE wrtchar END INTERFACE INTERFACE SUBROUTINE wrtint [C,ALIAS:’_wrtint’] fid, param INTEGER

Trang 1

DOUBLEPRECISION :: jnk3

INTEGER,PARAMETER :: mequil = 500

INTEGER :: equil

INTEGER,PARAMETER :: assoc = 1

INTEGER :: ninc

INTEGER :: i,j,k,l,flag

INTEGER :: local_inc

INTEGER :: kp_flag

CHARACTER(LEN=80) :: value

INTEGER :: stg_len

!=========================================================================

! -! Allocate space for stress history

! -CALL alloc8(Logfid,nstrain,ninc2,pthist1)

! -! Allocate space for strain history

! -CALL alloc8(Logfid,nstrain,ninc2,pthist2)

! -! Allocate space for plastic strain history

! -CALL alloc8(Logfid,nstrain,ninc2,ptplasstn)

! -! Allocate and initialize elastic stiffness tensor

! -ALLOCATE(Eo_ten(3,3,3,3))

CALL el_ten1(young,pois,Eo_ten)

! -! Allocate and initialize identity matrix

! -ALLOCATE(iden(3,3))

DO i = 1,3

DO j = 1,3

IF ( i eq j) THEN

iden(i,j) = 1.0d0

ELSE

iden(i,j) = 0.0d0

END IF

END DO

! -! Allocate plastic strain and tensile plastic strain tensor

! -ALLOCATE(plastic_eps(3,3,ninc2))

ALLOCATE(t_plastic_eps(3,3,ninc2))

! -! If required, allocate space for

! localization analysis results

! -IF (lclflg eq 1) THEN

ALLOCATE(local_data1(91,10,ninc2))

ALLOCATE(local_data2(ninc2))

END IF

local_inc = 0

Trang 2

! -! Initialize flags for pst file

! -pstpleps = 0

psteff = 0

! -! Initialize plasticity hardening/softening parameters

! -limit_ep_k = ko_dp

limit_ep_c = 1.0d0

kp_flag = 0

!=========================================================================

! BEGIN LOOP OVER LOAD STEPS

!=========================================================================

DO ninc=1,ninc2

!

-! Write to log file and screen echo

!

-value = "***** Increment "

stg_len = LEN_TRIM(value)

CALL wrtchar(Logfid, stg_len, TRIM(value))

CALL tab(Logfid)

CALL wrtint(Logfid,ninc)

value = " *****"

CALL newline(Logfid)

PRINT *,’ ’

PRINT *,’***** Increment ’,ninc,’ *****’

PRINT *,’ ’

!

-! Add current strains to strain history

!

-IF ( ninc eq 1 ) THEN

pthist2(:,ninc) = ptstrain(:,ninc)

ELSE

pthist2(:,ninc) = pthist2(:,ninc-1) + ptstrain(:,ninc)

END IF

!

-! Fill incremental strain matrix

!

-ALLOCATE(eps_dot(3,3))

eps_dot(1,1) = ptstrain(1,ninc)

eps_dot(1,2) = ptstrain(6,ninc) / 2.0d0

!

-! Initialize previous increment’s total strain tensor

!

-ALLOCATE(old_eps(3,3))

IF ( ninc eq 1 ) THEN

DO i = 1,3

DO j= 1,3

old_eps(i,j) = 0.0d0

END DO

Trang 3

old_eps(1,1) = pthist2(1,ninc-1)

old_eps(2,3) = pthist2(4,ninc-1) / 2.0d0

END IF

!

-! Determine trial elastic strain tensor

!

-ALLOCATE(tr_eps_e(3,3))

DO i = 1,3

DO j = 1,3

tr_eps_e(i,j) = old_eps(i,j) + eps_dot(i,j)

END DO

ELSE

DO i = 1,3

DO j = 1,3

tr_eps_e(i,j) = ( old_eps(i,j) - plastic_eps(i,j,ninc-1) ) + eps_dot(i,j)

END DO

END IF

!

-! Determine trial total strain tensor

!

-ALLOCATE(tr_eps(3,3))

DO i = 1,3

DO j = 1,3

tr_eps(i,j) = old_eps(i,j) + eps_dot(i,j)

END DO

!

-! Store previous stress state

!

-ALLOCATE(old_sig(3,3))

IF ( ninc ne 1 ) THEN

old_sig(1,1) = pthist1(1,ninc-1)

ELSE

DO i = 1,3

DO j = 1,3

old_sig(i,j) = 0.0d0

END DO

END IF

!

-! Determine stress increment

!

-ALLOCATE(sig_dot(3,3))

CALL contract42(sig_dot,Eo_ten,eps_dot)

Trang 4

! Determine trial stress

!

-ALLOCATE(tr_sig(3,3))

DO i = 1,3

DO j = 1,3

tr_sig(i,j) = old_sig(i,j) + sig_dot(i,j)

END DO

!

-! Determine plasticity limit point

!

-I1 = firstinv(3,tr_sig)

IF ( I1 ge 0.0d0 ) THEN

! Loading in tension

!

-beta = (1.0d0/3.0d0) * (fpc_dp*fpt_dp)

kp_flag = 1

limit_ep_k = 1.0d0

limit_ep_c = 1.0d0

ELSE

limit_ep_c = pd_limit_cp(Logfid,ninc,tr_sig,t_plastic_eps(:,:,ninc-1))

END IF

IF ( limit_ep_c lt 0.005d0 ) THEN

limit_ep_c = 0.005d0

END IF

IF ( limit_ep_c lt co_dp ) THEN

limit_ep_c = co_dp

END IF

limit_ep = limit_ep_k * limit_ep_c * beta

alpha = (1.0d0/3.0d0) * (fpc_dp - fpt_dp)

ELSE

! Loading in compression

!

-beta = (1.0d0/3.0d0) * (fpc_dp * fpt_dp)

limit_ep_c = 1.0d0

limit_ep_k = ko_dp

limit_ep = ko_dp * beta

GO TO 50

ELSE

limit_ep_k = pd_limit_kp(Logfid,tr_sig,plastic_eps(:,:,ninc-1))

limit_ep = limit_ep_k * beta

END IF

IF ( limit_ep_k eq 1.0d0 ) THEN

kp_flag = 1

END IF

! Make sure hardening parameter does not follow descending curve after k = 1.0

!

-IF ( kp_flag eq 1 ) THEN

limit_ep_c = pd_limit_cp(Logfid,ninc,tr_sig,t_plastic_eps(:,:,ninc-1))

IF ( limit_ep_c lt 0.005d0 ) THEN

limit_ep_c = 0.005d0

END IF

Trang 5

IF ( limit_ep_c lt co_dp ) THEN

limit_ep_c = co_dp

END IF

limit_ep = limit_ep_k * limit_ep_c * beta

END IF

alpha = limit_ep_c * limit_ep_k * (1.0d0/3.0d0) * (fpc_dp - fpt_dp)

END IF

50 CONTINUE

!

-! Evaluate yield function

!

-fail_ep = pd_yield(tr_sig,alpha,limit_ep)

IF ( fail_ep le 0.0d0 ) THEN

! ====================================================================

!

-! Write to log file and screen echo

!

-value = "Material is not yielded"

PRINT *,’Material is not yielded’

!

-! Save stress state

!

-pthist1(1,ninc) = tr_sig(1,1)

pthist1(2,ninc) = tr_sig(2,2)

!

-! Update plastic strains

!

-IF ( ninc ne 1 ) THEN

DO i =1,3

DO j = 1,3

plastic_eps(i,j,ninc) = plastic_eps(i,j,ninc-1)

t_plastic_eps(i,j,ninc) = t_plastic_eps(i,j,ninc-1)

END DO

ELSE

DO i =1,3

DO j = 1,3

plastic_eps(i,j,ninc) = 0.0d0

t_plastic_eps(i,j,ninc) = 0.0d0

END DO

END IF

!

-! Deallocate arrays

!

-DEALLOCATE(tr_sig,tr_eps,tr_eps_e)

Trang 6

ELSE IF ( fail_ep gt 0.0d0 ) THEN

! ====================================================================

!

-! Echo to log file and screen

!

-value = "Material has yielded"

PRINT *,’Material has yielded’

!

-! Set flag for plastic strains

!

-pstpleps = 1

!

-! Determine normal

!

-ALLOCATE(np_mat(3,3))

CALL pd_det_np(tr_sig,alpha,np_mat)

!

-! Determine plastic flow direction

!

-ALLOCATE(mp_mat(3,3))

IF ( assoc eq 0 ) THEN

! Non-associated flow

!

-CALL pd_det_mp(Logfid,tr_sig,mp_mat)

ELSE

! Associated flow

!

-CALL pd_det_np(tr_sig,alpha,mp_mat)

END IF

!

-! Determine barmp_mat = Eo : m

!

-ALLOCATE(barmp_mat(3,3))

CALL contract42(barmp_mat,Eo_ten,mp_mat)

!

-! Determine barhp = hp + n : Eo : m

! NOTE : hp = 0 for now!!!!!!

!

-hp = 0.0d0

nEon = contract22(3,np_mat,barmp_mat)

barhp = hp - nEon

!

-! Determine barnp_mat = n : Eo

!

-ALLOCATE(barnp_mat(3,3))

CALL contract24(barnp_mat,np_mat,Eo_ten)

!

Trang 7

-!

-ALLOCATE(dlam_deps(3,3))

DO i = 1,3

DO j = 1,3

dlam_deps(i,j) = (-1.0d0 / barhp) * barnp_mat(i,j)

END DO

!

-! Determine initial delta lambda

!

-dlam_ep_in = contract22(3,dlam_deps,eps_dot)

!

-! Solve for Fp = 0 (associated flow for now, replace

! np_mat with mp_mat to get non-associated flow)

!

-ALLOCATE(NR_sig(3,3))

ALLOCATE(iter_peps(3,3))

CALL pd_solv_ep(Logfid,ninc,Eo_ten,tr_eps,plastic_eps(:,:,ninc-1), &

np_mat,dlam_ep_in,alpha,limit_ep,NR_sig,iter_peps) value = "final stress"

call newline(Logfid)

call wrtmatrix(Logfid,3,3,NR_sig)

!

-! Store final stress state

!

-pthist1(1,ninc) = NR_sig(1,1)

pthist1(2,ninc) = NR_sig(2,2)

!

-! Determine nominal plastic strain increment

! and update total plastic strains

!

-DO i = 1,3

DO j = 1,3

plastic_eps(i,j,ninc) = iter_peps(i,j)

END DO

!

-! Determine plastic strain increment

!

-ALLOCATE(d_plas_eps(3,3))

DO i = 1,3

DO j = 1,3

d_plas_eps(i,j) = plastic_eps(i,j,ninc) - plastic_eps(i,j,ninc-1)

END DO

!

-! If kp = 1, determine and store tensile plastic strains

!

-IF ( kp_flag eq 1 ) THEN

DO i = 1,3

DO j = 1,3

IF ( d_plas_eps(i,j) gt 0.0d0 ) THEN

t_plastic_eps(i,j,ninc) = t_plastic_eps(i,j,ninc-1) + d_plas_eps(i,j) ELSE

Trang 8

END IF

END DO

ELSE

DO i = 1,3

DO j = 1,3

t_plastic_eps(i,j,ninc) = t_plastic_eps(i,j,ninc-1)

END DO

END IF

!

-! Update normals

!

-DEALLOCATE(np_mat)

ALLOCATE(np_mat(3,3))

CALL pd_det_np(NR_sig,alpha,np_mat)

DEALLOCATE(mp_mat)

ALLOCATE(mp_mat(3,3))

IF ( assoc eq 0 ) THEN

! Non-associated flow

!

-CALL pd_det_mp(Logfid,NR_sig,mp_mat)

ELSE

! Associated flow

!

-CALL pd_det_np(NR_sig,alpha,mp_mat)

END IF

!

-! Determine hardening parameter

!

-hp = pd_det_ -hp(Logfid,ninc,Eo_ten,NR_sig,np_mat,np_mat,plastic_eps(:,:,ninc-1), &

t_plastic_eps(:,:,ninc-1),limit_ep_k,limit_ep_c)

!

-! Determine tangent operator (Associated flow now)

!

-ALLOCATE(Et_ten(3,3,3,3))

CALL pd_tangent(Logfid,Eo_ten,np_mat,np_mat,hp,Et_ten)

!

-! If requested, perform localization analysis

!

-IF (lclflg eq 1) THEN

local_inc = local_inc + 1

local_data2(local_inc) = ninc

CALL acoust3d(local_inc,ninc1,local_data1,Eo_ten,Et_ten)

END IF

!

-! Deallocate arrays

!

-DEALLOCATE(tr_eps,tr_eps_e)

DEALLOCATE(old_eps,eps_dot)

DEALLOCATE(old_sig,sig_dot)

DEALLOCATE(tr_sig)

DEALLOCATE(NR_sig)

DEALLOCATE(iter_peps)

DEALLOCATE(np_mat,mp_mat,barnp_mat,barmp_mat)

DEALLOCATE(dlam_deps)

DEALLOCATE(d_plas_eps)

DEALLOCATE(Et_ten)

Trang 9

!

-! End elastic/damaged check

!

-END IF

!=========================================================================

! END LOOP OVER LOAD STEPS

!=========================================================================

END DO

! -! Write localization file if needed

! -IF ( lclflg eq 1 ) THEN

! Screen echo

!

-PRINT *,’ ’

PRINT *,’Writing Q-Analysis results to lcl file’

! Write localization file

!

-CALL write_lcl(Lclfid,local_inc,ninc1,local_data1,local_data2)

! Log file echo

!

-value = "Q-Analysis results written to lcl file"

! Deallocate Q-Analysis data arrays

!

-DEALLOCATE(local_data1)

DEALLOCATE(local_data2)

END IF

! -! Store plastic strains

! -DO i = 1,ninc2

ptplasstn(1,i) = plastic_eps(1,1,i)

ptplasstn(4,i) = plastic_eps(2,3,i) * 2.0d0

END DO

DEALLOCATE(plastic_eps)

DEALLOCATE(t_plastic_eps)

! -! Deallocate elastic stiffness tensor

! -DEALLOCATE(Eo_ten)

! -! Deallocate identity matrix

! -DEALLOCATE(iden)

! -! Write results to output file

! -CALL write_out(Logfid,Outfid)

Trang 10

! Write post file

! -CALL write_pst(Logfid,Pstfid)

! -! Close log file

! -CALL close_file(Logfid)

END SUBROUTINE pd_strain

==========================================================================

SUBROUTINE pd_solv_ep(Logfid,ninc,Eo_ten,eps,plas_eps,m_mat,dlam_in,alpha, &

limit_ep,sig_out,peps_out)

! PD_SOLV_EP - Solve for Fp = 0 using bisection/cutting plane algorithm

!

! Variables required

!

-! Logfid = Log file ID

! ninc = Current load increment

! Es_ten = Secant stiffness tensor

! eps = Trial strain tensor

! plas_eps = Previous increment’s plastic strain tensor

! m_mat = Current plastic flow direction

! dlam_in = Initial delta lambda value

! limit_ep = Material strength point

!

! Variables returned

!

-! sig_out = Final stress state

! peps_out = Final plastic strain state

!

! Subroutine called by

!

-! pd_strain.f90 = Strain controlled parabolic Drucker-Prager model

! pd_mixed.f90 = Mixed controlled parabolic Drucker-Prager model

!

! Functions/subroutines called

!

-!

!

! Variable definition

!

-!

!

!=========================================================================

IMPLICIT NONE

! -! Define interface with C subroutines

! -INTERFACE

SUBROUTINE newline [C,ALIAS:’_newline’] (fid)

INTEGER fid [REFERENCE]

END SUBROUTINE newline

END INTERFACE

INTERFACE

SUBROUTINE tab [C,ALIAS:’_tab’] (fid)

END SUBROUTINE tab

END INTERFACE

INTERFACE

Trang 11

INTEGER stg_len [REFERENCE]

CHARACTER*80 string [REFERENCE]

END SUBROUTINE wrtchar

END INTERFACE

INTERFACE

SUBROUTINE wrtint [C,ALIAS:’_wrtint’] (fid, param)

INTEGER param [REFERENCE]

END SUBROUTINE wrtint

END INTERFACE

INTERFACE

SUBROUTINE wrtreal [C,ALIAS:’_wrtreal’] (fid, param)

DOUBLEPRECISION param [REFERENCE]

END SUBROUTINE wrtreal

END INTERFACE

INTERFACE

SUBROUTINE wrtexp [C,ALIAS:’_wrtexp’] (fid, param)

DOUBLEPRECISION param [REFERENCE]

END SUBROUTINE wrtexp

END INTERFACE

! -! External function declaration

! -DOUBLEPRECISION,EXTERNAL :: pd_yield

DOUBLEPRECISION,EXTERNAL :: contract22

! -! Common variables

! -INTEGER :: mtype,ninc1,ninc2

INTEGER :: nstress,nstrain,ctype

COMMON /control/ mtype,ninc1,ninc2,nstress,nstrain,ctype

! -! Local Variable Type Declaration

! -INTEGER,INTENT(IN) :: Logfid,ninc

DOUBLEPRECISION,DIMENSION(3,3,3,3),INTENT(IN) :: Eo_ten

DOUBLEPRECISION,DIMENSION(3,3),INTENT(IN) :: eps,plas_eps,m_mat

DOUBLEPRECISION,INTENT(IN) :: dlam_in,alpha,limit_ep

DOUBLEPRECISION,DIMENSION(3,3),INTENT(OUT) :: sig_out,peps_out

DOUBLEPRECISION,ALLOCATABLE,DIMENSION(:,:,:) :: iter_sig,iter_eps

DOUBLEPRECISION,ALLOCATABLE,DIMENSION(:,:,:) :: iter_peps

DOUBLEPRECISION,ALLOCATABLE,DIMENSION(:,:) :: plas_sig

DOUBLEPRECISION,ALLOCATABLE,DIMENSION(:,:) :: peps_dot

DOUBLEPRECISION :: f,f0,f1,f2,f_prev,f_conv

DOUBLEPRECISION :: dlam,dlam1,dlam2

DOUBLEPRECISION,PARAMETER :: tol = 1.0E-10

INTEGER,PARAMETER :: miters = 500

INTEGER :: iter

INTEGER :: i,j,k,l

INTEGER :: iloc

CHARACTER(LEN=80) :: value

INTEGER :: stg_len

Trang 12

! -! Allocate iterative stress and strain state

! -ALLOCATE(iter_sig(3,3,miters))

ALLOCATE(iter_eps(3,3,miters))

! -! Allocate iterative plastic strain state

! -ALLOCATE(iter_peps(3,3,miters))

! -! Initialize bisection parameters

! -dlam = 0.0d0

dlam1 = 0.0d0

dlam2 = 0.0d0

iloc = 0

f0 = 0.0d0

f1 = 0.0d0

f2 = 0.0d0

! -! Midpoint algorithm for Fp = 0

! -DO iter = 1,miters

! Determine plastic strain rate

!

-ALLOCATE(peps_dot(3,3))

DO i = 1,3

DO j = 1,3

peps_dot(i,j) = dlam * m_mat(i,j)

END DO

! Update total plastic strains

!

-DO i = 1,3

DO j = 1,3

iter_peps(i,j,iter) = plas_eps(i,j) + peps_dot(i,j)

END DO

! Determine new elastic strain state

!

-DO i = 1,3

DO j = 1,3

iter_eps(i,j,iter) = eps(i,j) - iter_peps(i,j,iter)

END DO

! Determine new stress state

!

-CALL contract42(iter_sig(:,:,iter),Eo_ten,iter_eps(:,:,iter))

! Determine new damage function value

!

-f_prev = f

f = pd_yield(iter_sig(:,:,iter),alpha,limit_ep)

! Check convergence

!

-f_conv = f - f_prev

Định dạng
Số trang	20
Dung lượng	177,43 KB