SPEED
MAKE_ELTENSOR_FOR_CASES_NLE.f90
Go to the documentation of this file.
1! Copyright (C) 2012 The SPEED FOUNDATION
2! Author: Ilario Mazzieri
3!
4! This file is part of SPEED.
5!
6! SPEED is free software; you can redistribute it and/or modify it
7! under the terms of the GNU Affero General Public License as
8! published by the Free Software Foundation, either version 3 of the
9! License, or (at your option) any later version.
10!
11! SPEED is distributed in the hope that it will be useful, but
12! WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14! Affero General Public License for more details.
15!
16! You should have received a copy of the GNU Affero General Public License
17! along with SPEED. If not, see <http://www.gnu.org/licenses/>.
18
19
43
44 subroutine make_eltensor_for_cases_nle(vcase,R_el,&
45 nn,rho_el,lambda_el,mu_el,gamma_el,&
46 cs_nnz,cs,ielem,&
47 func_type,func_indx,func_data,nfdata,&
48 nf,t_stress,tag_func,yon,tcase,&
49 nnod_loc,vs_tria)
50
51
52
53 implicit none
54
55 integer*4 :: vcase
56 integer*4 :: nn
57 integer*4 :: p,q,r
58 integer*4 :: is,in,ielem
59 integer*4 :: cs_nnz
60 integer*4 :: nf,fn,nfdata,tcase,nnod_loc
61
62 integer*4, dimension(nf) :: tag_func
63 integer*4, dimension(nf) :: func_type
64 integer*4, dimension(nf +1) :: func_indx
65 integer*4, dimension(0:cs_nnz) :: cs
66
67 integer*4, dimension(nn,nn,nn) :: yon
68
69 real*8 :: vs,vp
70 real*8 :: vratio
71 real*8 :: t_stress
72 real*8 :: get_func_value
73 real*8 :: reduction_factor
74
75 real*8, dimension(nfdata) :: func_data
76 real*8, dimension(nnod_loc) :: vs_tria
77
78 real*8, dimension(nn,nn,nn) :: rho_el,lambda_el,mu_el,gamma_el
79 real*8, dimension(nn,nn,nn) :: r_el
80
81
82
83
84 do r = 1,nn
85 do q = 1,nn
86 do p = 1,nn
87
88 is = nn*nn*(r -1) +nn*(q -1) +p
89 in = cs(cs(ielem -1) +is)
90
91 if (yon(p,q,r).eq.1) then
92
93 vs = dsqrt( mu_el(p,q,r) / rho_el(p,q,r) )
94 vp = dsqrt( (lambda_el(p,q,r) + 2*mu_el(p,q,r) ) / rho_el(p,q,r) )
95 vratio = vp/vs
96
97 !-------------------------------------------------------------------
98 !
99 if(tcase .ne. 16) then
100 do fn = 1,nf
101 if (vcase .eq. tag_func(fn)) then
102 if (func_type(fn) .eq. 60 ) then
103
104 reduction_factor = get_func_value(nf,func_type,func_indx,func_data, nfdata, &
105 fn,r_el(p,q,r),0,0)
106
107 mu_el(p,q,r) = mu_el(p,q,r) * reduction_factor
108 vs = dsqrt(mu_el(p,q,r)/rho_el(p,q,r))
109 vp = vs * vratio
110 lambda_el(p,q,r)= rho_el(p,q,r)*(vp**2)-2*mu_el(p,q,r)
111
112 endif
113 endif
114 enddo
115
116 elseif (tcase .eq. 16) then
117
118 do fn = 1,nf
119 if (vcase .eq. tag_func(fn)) then
120 if (func_type(fn) .eq. 60 .and. vs_tria(in) .lt. 325.d0) then
121
122 reduction_factor = get_func_value(nf,func_type,func_indx,func_data, nfdata, &
123 fn,r_el(p,q,r),0,0)
124
125 mu_el(p,q,r) = mu_el(p,q,r) * reduction_factor
126 vs = dsqrt(mu_el(p,q,r)/rho_el(p,q,r))
127 vp = vs * vratio
128 lambda_el(p,q,r)= rho_el(p,q,r)*(vp**2)-2*mu_el(p,q,r)
129
130 elseif (func_type(fn) .eq. 62 .and. vs_tria(in) .lt. 450.d0) then
131
132 reduction_factor = get_func_value(nf,func_type,func_indx,func_data, nfdata, &
133 fn,r_el(p,q,r),0,0)
134
135 mu_el(p,q,r) = mu_el(p,q,r) * reduction_factor
136 vs = dsqrt(mu_el(p,q,r)/rho_el(p,q,r))
137 vp = vs * vratio
138 lambda_el(p,q,r)= rho_el(p,q,r)*(vp**2)-2*mu_el(p,q,r)
139
140
141
142 endif
143
144 endif
145 enddo
146
147 endif!tcase = 16
148
149
150 !
151 !-------------------------------------------------------------------
152
153 endif !if (yon(i,j,k).eq.1) then
154
155 enddo
156 enddo
157 enddo
158
159 return
160
161 end subroutine make_eltensor_for_cases_nle
162
get_func_value
real *8 function get_func_value(nb_fnc, type_fnc, ind_fnc, data_fnc, nb_data_fnc, id_fnc, time
Computes time evolution function.
Definition GET_FUNC_VALUE.f90:38
make_eltensor_for_cases_nle
subroutine make_eltensor_for_cases_nle(vcase, r_el, nn, rho_el, lambda_el, mu_el, gamma_el, cs_nnz, cs, ielem, func_type, func_indx, func_data, nfdata, nf, t_stress, tag_func, yon, tcase, nnod_loc, vs_tria)
Assignes material properties node by node for non linear elasticity.
Definition MAKE_ELTENSOR_FOR_CASES_NLE.f90:50