39
40
41
42
43
44
45
46
47
48
49
50
54
55
56
57#include "implicit_f.inc"
58
59
60
61#include "mvsiz_p.inc"
62
63
64
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "com08_c.inc"
68#include "vect01_c.inc"
69#include "inter22.inc"
70#include "param_c.inc"
71
72
73
74
75
76
77
78
79 INTEGER :: IXS(NIXS,*), IALEFVM_FLG, (NPROPMI,*),NEL
80 my_real :: mom(nel,3), vol(mvsiz), rho(mvsiz), iad22(*),ssp(*),sig(nel,6)
81
82
83
84 INTEGER :: I, II, J, IMAT, , NIN, IB
86 LOGICAL :: debug_outp
87 INTEGER :: idbf,idbl
88
89
90
92 IF(ialefvm_flg <= 1)RETURN
93 imat = ixs(1,1+nft)
94 ilaw = ipm(2,imat)
95
96
97
98
99
100 IF(ilaw /= 11)THEN
101
102
103
104 DO i=1,nel
105 ii = i + nft
107 IF(dt1==zero)THEN
108 dmom(1:3,i) = half*dt2 * dmom(1:3,i)
109 ELSE
110 dmom(1:3,i) = dt2 * dmom(1:3,i)
111 ENDIF
112 enddo
113
114 DO i=1,nel
115 ii = i + nft
116 mom(i,1) = mom(i,1) + dmom(1,i)
117 mom(i,2) = mom(i,2) + dmom(2,i)
118 mom(i,3) = mom(i,3) + dmom(3,i)
119 enddo
120
121
122
124 debug_outp = .false.
126 do i=lft,llt
127 ii = nft + i
129 debug_outp = .true.
130 idbf = i
131 idbl = i
132 EXIT
133 endif
134 enddo
136 debug_outp=.true.
137 idbf = lft
138 idbl = llt
139 endif
140 if(debug_outp)then
141
142 print *, " |----alefvm_scheme.F-----|"
143 print *, " | THREAD INFORMATION |"
144 print *, " |------------------------|"
145 print *, " NCYCLE =", ncycle
146 do i=idbf,idbl
147 ii = nft + i
148 print *, " brique=", ixs(11,nft+i
149 write(*,fmt='(A,1E26.14)') " RHO ="
150 write(*,fmt='(A,1E26.14)') " VOL ="
151 write(*,fmt='(A,1E26.14)') " MASS =", rho
152 write(*,fmt='(A)') " #-- cell momentum --#"
153 write (*,fmt='(3(A,1E26.14))') " q-x =", MOM(I,1) -dMOM(1,I),"",dMOM(1,I),"",MOM(I,1)
154 write (*,FMT='(3(A,1E26.14))') " q-y =", MOM(I,2) -dMOM(2,I)," +",dMOM(2,I)," =",MOM(I,2)
155 write (*,FMT='(3(A,1E26.14))') " q-z =", MOM(I,3) -dMOM(3,I)," +",dMOM(3,I)," =",MOM(I,3)
156 write(*,FMT='(A)') " #-- cell momentum densities--#"
157 write (*,fmt='(3(A,1E26.14))') " rho.Ux =", mom(i,1) / vol(i)
158 write (*,fmt='(3(A,1E26.14))') " rho.Uy =", mom(i,2) / vol(i)
159 write (*,fmt='(3(A,1E26.14))') " rho.Uz =", mom(i,3)
160 write(*,fmt='(A)') " #-- cell velocities--#"
161 write (*,fmt='(3(A,1E26.14))') " Ux =", mom(i,1) / vol(i)/rho(i)
162 write (*,fmt='(3(A,1E26.14))') " Uy =", mom(i,2) / vol(i)/rho(i)
163 write (*,fmt='(3(A,1E26.14))') " Uz =", mom(i,3) / vol(i)/rho(i)
164 print *, " "
165 enddo
166 !#!include "lockoff.inc"
167 endif
168 endif
169
170 ENDIF !IF(ilaw /= 11)THEN
171
172
173
175
176 DO i=1,nel
177
178 ii = i + nft
179
180
181
182
183 mom(i,1) = mom(i,1) / vol(i)
184 mom(i,2) = mom(i,2) / vol(i)
185 mom(i,3) = mom(i,3) / vol(i)
186 enddo
187
188
189 IF(int22 > 0)THEN
190
191 DO i=1,nel
192 ii = i + nft
196 enddo
197
198 nin = 1
199 DO i=1,nel
200 ii = i+nft
201 ib = nint(iad22(i))
202 IF (ib>0)THEN
204 ENDIF
205 ENDDO
206
207 ENDIF
208
209
210 DO i=1,nel
211 ii = i + nft
217 alefvm_buffer%FCELL(6,ii) = -third*(sig(i,1)+sig(i,2)+sig(i,3))
218 enddo
219
220
221
222
223
224 RETURN
subroutine alefvm_expand_mom2(ixs, mom, nel)
type(alefvm_buffer_), target alefvm_buffer
type(alefvm_param_), target alefvm_param
type(brick_entity), dimension(:,:), allocatable, target brick_list