33
34
35
36
37
38
39
40
41
42
43
44
47 use element_mod , only : nixs
48
49
50
51#include "implicit_f.inc"
52
53
54
55#include "mvsiz_p.inc"
56
57
58
59#include "vect01_c.inc"
60#include "com01_c.inc"
61#include "inter22.inc"
62#include "param_c.inc"
63
64
65
66
67
68
69
70
71 INTEGER :: IXS(NIXS,*)
72 my_real :: voln(mvsiz),rho(mvsiz),iad22(*)
73
74
75
76 INTEGER :: I, J, K, IB, MNOD
77 INTEGER :: NVERTEX,INOd,II, NIN
78 my_real :: m_cell(mvsiz),accel(3,mvsiz)
79 LOGICAL :: debug_outp
80 INTEGER :: idbf,idbl , MCELL
81
82
83
85 IF(int22==0) RETURN
86
87
88
89
90 nin = 1
91
92
93
94
95 DO i=lft,llt
96 ib = nint(iad22(i))
97 IF(ib<=0)cycle
98 ii = i+nft
99 nvertex = 0
100 accel(1:3,i) = zero
102
105 DO k=1,mnod
106 j =
brick_list(nin,ib)%POLY(mcell)%ListNodID(k)
107 inod = ixs(1+j,i+nft)
109 nvertex = nvertex + 1
113 ENDDO
114 IF(nvertex>0)THEN
115 accel(1,i) = accel(1,i) / nvertex
116 accel(2,i) = accel(2,i) / nvertex
117 accel(3,i) = accel(3,i) / nvertex
118 ENDIF
119 enddo
120
121 DO i=lft,llt
122 m_cell(i) = rho(i)*voln(i)
123 enddo
124
125 DO i=lft,llt
126 ib = nint(iad22(i))
127 IF(ib<=0)cycle
128 ii = i + nft
132 enddo
133
134
136 debug_outp = .false.
138 do i=lft,llt
139 ii = nft + i
141 debug_outp = .true.
142 idbf = i
143 idbl = i
144 EXIT
145 endif
146 enddo
148 debug_outp=.true.
149 idbf = lft
150 idbl = llt
151 endif
152
153 if(debug_outp)then
154
155 print *, " |----alefvm_gravity.F----|"
156 print *, " | THREAD INFORMATION |"
157 print *, " |------------------------|"
158 print *, " NCYCLE =", ncycle
159 do i=idbf,idbl
160 ii = nft + i
161 ib = nint(iad22(i))
162 IF(ib<=0)cycle
163 print *, " brique=", ixs(11,nft+i)
164 write(*,fmt='(A24,1A26)') " ",
165 . "#--------- cell----------#"
166 write (*,fmt='(A,1E26.14)') " Rho =", rho(i)
167 write (*,fmt='(A,1E26.14)') " Vol =", voln(i)
168 write (*,fmt='(A,1E26.14)') " Mass =", m_cell(i)
169 write (*,fmt='(A,1E26.14)') " Accel-X =", accel(1,i)
170 write (*,fmt='(A,1E26.14)') " Accel-Y =", accel(2,i)
171 write (*,fmt='(A,1E26.14)') " Accel-Z =", accel(3,i)
172 write(*,fmt='(A24,8A26)') " ",
173 . "#--------- nod_1 ---------","#--------- nod_2 ---------",
174 . "#--------- nod_3 ---------","#--------- nod_4 ---------",
175 . "#--------- nod_5 ---------","#--------- nod_6 ---------",
176 . "#--------- nod_7 ---------","#--------- nod_8 --------#"
177 write (*,fmt=
'(A,8E26.14)')
" acc-X =",
alefvm_buffer%VERTEX(1,ixs(2:9,i))
178 write (*,fmt=
'(A,8E26.14)')
" acc-Y =",
alefvm_buffer%VERTEX(2,ixs(2:9,i))
179 write (*,fmt=
'(A,8E26.14)')
" acc-Z =",
alefvm_buffer%VERTEX(3,ixs(2:9,i))
180 print *, " "
181 enddo
182
183 endif
184 endif
185
186
187
188
189 RETURN
type(alefvm_buffer_), target alefvm_buffer
type(alefvm_param_), target alefvm_param
type(brick_entity), dimension(:,:), allocatable, target brick_list