-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathtest_cohesive_material.f90
200 lines (152 loc) · 4.66 KB
/
test_cohesive_material.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
include 'globals/parameter_module.f90'
include 'materials/cohesive_material_module.f90'
program test_cohesive_material
! Purpose:
! to perform unit testing on cohesive_material_module
!
!
! Record of revision:
! Date Programmer Description of change
! ======== ==================== ========================================
! 06/04/15 B. Y. Chen Original code
! 11/04/15 B. Y. Chen added testing of cohesive_ig_point
!
!
use parameter_module, NST => NST_COHESIVE
use cohesive_material_module
implicit none
! declare variables:
! this
! modulus
! strength
! toughness
! sdv
! dee
! traction, separation
! istat
! emsg
! d_max
type(cohesive_material) :: this
type(cohesive_sdv) :: sdv
real(DP) :: dee(NST,NST)
real(DP) :: traction(NST), separation(NST)
integer :: istat
character(MSGLENGTH) :: emsg
real(DP) :: d_max
type(cohesive_ig_point) :: ig_point
real(DP) :: igx(NDIM), igu(NDIM), igtract(NST), igsepar(NST)
type(cohesive_sdv) :: igsdv1, igsdv2
character(len=20) :: display_fmt
character(len=10) :: cndim, cnst
logical :: nofailure
! initialize local variables
! all derived types have been initialized in definition
dee = ZERO
traction = ZERO
separation = ZERO
istat = STAT_SUCCESS
emsg = ''
d_max = ZERO
display_fmt = ''
cndim = ''
cnst = ''
nofailure = .false.
igx = ZERO
igu = ZERO
igtract = ZERO
igsepar = ZERO
! define separation
separation(1) = -0.006_DP
separation(2) = 0.02_DP
separation(3) = 0.02_DP
! define d_max
d_max = ONE
! store ndim and nst as strings in cndim and cnst
write(cndim,'(i5)') NDIM
write(cnst,'(i5)') NST
! call all public procedures, test their correctness
call empty (this)
call display (this)
call set (this, modulus=cohesive_modulus(Dnn=1000000._DP, Dtt=1000000._DP, Dll=1000000._DP), &
& strength=cohesive_strength(tau_nc=60._DP, tau_tc=90._DP, tau_lc=90._DP), &
& toughness=cohesive_toughness(Gnc=0.2_DP, Gtc=1._DP, Glc=1._DP, alpha=1._DP), &
& istat=istat, emsg=emsg)
if(istat == STAT_FAILURE) then
write(*,*) emsg
return
end if
call display (this)
!nofailure = .true.
nofailure = .false.
if (nofailure) then
call ddsdde (this, dee=dee, traction=traction, separation=separation)
else
call ddsdde (this, dee=dee, traction=traction, sdv=sdv, separation=separation, &
& istat=istat, emsg=emsg, d_max=d_max)
end if
if(istat == STAT_FAILURE) then
write(*,*) emsg
return
end if
! check to see if outputs are correct
! variables to check:
! traction
! sdv
! istat
! emsg
! set display format, note that for scientific real, ESw.d, w>=d+7
display_fmt = '(1X, A, ES10.3)'
write(*,'(A)') ''
write(*,'(A)') 'display the traction components:'
write(*,display_fmt) 'tau_n: ', traction(1)
write(*,display_fmt) 'tau_t: ', traction(2)
write(*,display_fmt) 'tau_l: ', traction(3)
write(*,'(A)') ''
call display (sdv)
write(*,'(A)') ''
write(*,'(A)') 'display the status and message:'
write(*,*) istat
write(*,*) emsg
write(*,'(A)') ''
write(*,'(A)') ''
write(*,'(A)') 'test cohesive_ig_point:'
write(*,'(A)') ''
write(*,'(A)') 'display the cohesive_ig_point before any update:'
call display(ig_point)
igx = ONE
igu = ONE
call update(ig_point, x=igx, u=igu)
write(*,'(A)') 'display the cohesive_ig_point after updates on x and u:'
call display(ig_point)
igtract = ONE
igsepar = ONE
!igsdv1=cohesive_sdv(dm=0.5_DP, u0=0.5_DP, uf=1.5_DP, fstat=COH_MAT_ONSET)
!igsdv2=cohesive_sdv(dm=0.9_DP, u0=0.5_DP, uf=1.5_DP, fstat=COH_MAT_FAILED)
call update(ig_point, traction=igtract, separation=igsepar, &
& converged_sdv=igsdv1, iterating_sdv=igsdv2)
write(*,'(A)') 'display the cohesive_ig_point after all updates:'
call display(ig_point)
write(*,'(A)') ''
write(*,'(A)') 'check extracted values from ig_point'
igx = ZERO
igu = ZERO
igtract = ZERO
igsepar = ZERO
!igsdv1 = cohesive_sdv(ZERO, ZERO, ZERO, INTACT)
!igsdv2 = cohesive_sdv(ZERO, ZERO, ZERO, INTACT)
call extract(ig_point, x=igx, u=igu, traction=igtract, separation=igsepar, &
& converged_sdv=igsdv1, iterating_sdv=igsdv2)
write(*,'(A)') ''
write(*,'(A)') 'display extracted values from ig_point'
display_fmt = '(1X, A,'//trim(adjustl(cndim))//'ES10.3)'
write(*,display_fmt) '- x :', igx
write(*,display_fmt) '- u :', igu
display_fmt = '(1X, A,'//trim(adjustl(cnst))//'ES10.3)'
write(*,display_fmt) '- traction :', igtract
write(*,display_fmt) '- separation :', igsepar
call display(igsdv1)
call display(igsdv2)
call empty(ig_point)
write(*,'(A)') 'display the cohesive_ig_point after being emptied:'
call display(ig_point)
end program test_cohesive_material