55
56
57
59 USE elbufdef_mod
66 USE multimat_param_mod , ONLY : m51_nvphas, m51_n0phas
67 use element_mod , only : nixs,nixq
68
69
70
71#include "implicit_f.inc"
72
73
74
75#include "com01_c.inc"
76#include "com04_c.inc"
77#include "vect01_c.inc"
78#include "param_c.inc"
79#include "task_c.inc"
80#include "spmd_c.inc"
81#include "inter22.inc"
82#include "warn_c.inc"
83
84
85
86 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
87
88 INTEGER IPARG(NPARG,NGROUP),NVAR,ITRIMAT,
89 . NERCVOIS(*),NESDVOIS(*),LERCVOIS(*), LESDVOIS(*),
90 . BHOLE(*),IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ), LENCOM,
91 . IFLG, ITASK
92
93 my_real flux(*), flu1(*) , phi(*) ,
94 . qmv(*) , pm(npropm,nummat), x(3, numnod)
95
96 TYPE(t_segvar) :: SEGVAR
97 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
98
99
100
101 INTEGER NMN, NM, NG, JMUL, IADR, I, J, K, NF1,ISILENT,NFX, IOFF, IMAT
102 INTEGER JCODV(ALE%GLOBAL%LCONV),CODTOT,NGSEG,ISEG,ISOLNOD
103 INTEGER ADD0, ADD
104
105 TYPE(L_BUFEL_) ,POINTER :: LBUF
106 TYPE(G_BUFEL_) ,POINTER :: GBUF
107 TYPE(BUF_MAT_) ,POINTER :: MBUF
108
109 my_real,
DIMENSION(:),
POINTER :: var, prho , pvol , peint, piad22
110 INTEGER :: ICELLv,IB,IBv,NIN,NUM, MCELL, IDX, NDIM
111
112
113
114
116
117
118 NULLIFY (var)
119
120
121
122
123
125
126 DO nm=1,nmn
127 DO ng=itask+1,ngroup,nthread
128
129 IF (iparg(76, ng) == 1) cycle
131 2 mtn ,llt ,nft ,iadr ,ity ,
132 3 npt ,jale ,ismstr ,jeul ,jtur ,
133 4 jthe ,jlag ,jmul ,jhbe ,jivf ,
134 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
135 6 irep ,iint ,igtyp ,israt ,isrot ,
136 7 icsen ,isorth ,isorthg ,ifailure,jsms )
137 isilent = iparg(64,ng)
138
139
140
141 IF (jale+jeul == 0) cycle
142 IF (iparg(8,ng) == 1) cycle
143 IF (
max(1,jmul) < nm) cycle
144 IF (itrimat /= 0 .AND. mtn /= 51) cycle
145
146
147
148 gbuf => elbuf_tab(ng)%GBUF
149 lbuf => elbuf_tab(ng)%BUFLY(nm)%LBUF(1,1,1)
150 mbuf => elbuf_tab(ng)%BUFLY(nm)%MAT(1,1,1)
151
152 CALL varcondec(jcodv,iparg(34,ng),codtot)
153 IF (jcodv(
nvar) /= 0)
THEN
154 isolnod = iparg(28,ng)
155 IF (jmul /= 0) mtn =iparg(24+nm,ng)
156 lft=1
157
158
159
160
161
163 IF(itrimat==0)THEN
164 prho => lbuf%RHO(1:llt)
165 pvol => lbuf%VOL(1:llt)
166 ELSE
167
168 add0 = m51_n0phas + (itrimat-1)*m51_nvphas
169 add = add0 + 9
170 k = llt*(add-1)
171 prho => mbuf%VAR(k+1:k+llt)
172 add = add0 + 11
173 k = llt*(add-1)
174 pvol => mbuf%VAR(k+1:k+llt)
175
176 END IF
177#include "vectorize.inc"
178 DO i=lft,llt
179 j=i+nft
180 phi(j)=prho(i)
181 ENDDO
182 DO i=lft,llt
183 prho(i) = prho(i)*pvol(i)
184 ENDDO
185
186
187
188
189
190 ELSEIF (
nvar == 2)
THEN
191 IF(itrimat == 0)THEN
192 peint=> lbuf%EINT(1:llt)
193 pvol => lbuf%VOL(1:llt)
194 ELSE
195
196 add0 = m51_n0phas + (itrimat-1)*m51_nvphas
197 add = add0 + 8
198 k = llt*(add-1)
199 peint=> mbuf%VAR(k+1:k+llt)
200 add = add0 + 11
201 k = llt*(add-1)
202 pvol => mbuf%VAR(k+1:k+llt)
203 END IF
204#include "vectorize.inc"
205 DO i=lft,llt
206 j=i+nft
207 phi(j)=peint(i)
208 ENDDO
209 DO i=lft,llt
210 peint(i) = peint(i)*pvol(i)
211 ENDDO
212
213
214
215 ELSEIF (
nvar == 3)
THEN
216#include "vectorize.inc"
217 DO i=lft,llt
218 j=i+nft
219 phi(j)=lbuf%RK(i)
220 ENDDO
221 DO i=lft,llt
222 lbuf%RK(i) = lbuf%RK(i)*lbuf%VOL(i)
223 ENDDO
224
225
226
227 ELSEIF (
nvar == 4)
THEN
228#include "vectorize.inc"
229 DO i=lft,llt
230 j=i+nft
231 phi(j)=lbuf%RE(i)
232 ENDDO
233 DO i=lft,llt
234 lbuf%RE(i) = lbuf%RE(i)*lbuf%VOL(i)
235 ENDDO
236
237
238
239
240
241
242
243
244 ELSEIF (
nvar == 5)
THEN
245 var => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR(1:llt)
246 IF (mtn == 41) THEN
247 prho => gbuf%RHO
248#include "vectorize.inc"
249 DO i=lft,llt
250 j=i+nft
251 phi(j) = var(i) * prho(i)
252 ENDDO
253 DO i=lft,llt
254 var(i) = var(i) * prho(i) * lbuf%VOL(i)
255 ENDDO
256 ELSE
257#include "vectorize.inc"
258 DO i=lft,llt
259 j=i+nft
260 phi(j) = var(i)
261 ENDDO
262 DO i=lft,llt
263 var(i) = var(i)*lbuf%VOL(i)
264 ENDDO
265 ENDIF
266
267
268
269
270
271 ELSEIF (
nvar == 6)
THEN
272 IF(itrimat == 0)THEN
273 idx = 1
274 ndim = 3
275 var => gbuf%MOM(1:llt*ndim)
276#include "vectorize.inc"
277 DO i=lft,llt
278 j = i+nft
279 k = llt*(idx-1) + i
280 phi(j) = var(k)
281 var(k) = var(k) *lbuf%VOL(i)
282 ENDDO
283 ENDIF
284
285
286
287
288
289
290 ELSEIF (
nvar == 7)
THEN
291 IF(itrimat == 0)THEN
292 idx = 2
293 ndim = 3
294 var => gbuf%MOM(1:llt*ndim)
295#include "vectorize.inc"
296 DO i=lft,llt
297 j = i+nft
298 k = llt*(idx-1) + i
299 phi(j) = var(k)
300 var(k) = var(k) *lbuf%VOL(i)
301 ENDDO
302 ENDIF
303
304
305
306
307
308
309 ELSEIF (
nvar == 8)
THEN
310 IF(itrimat == 0)THEN
311 idx = 3
312 ndim = 3
313 var => gbuf%MOM(1:llt*ndim)
314#include "vectorize.inc"
315 DO i=lft,llt
316 j = i+nft
317 k = llt*(idx-1) + i
318 phi(j) = var(k)
319 var(k) = var(k) *lbuf%VOL(i)
320 ENDDO
321 ENDIF
322
323 ELSEIF (
nvar == 9 .AND. isilent == 1)
THEN
324 ELSEIF (
nvar == 10 .AND. isilent == 1)
THEN
325 ELSE
326
327
328
329 IF (n2d == 0) THEN
330#include "vectorize.inc"
331 DO i=lft,llt
332 j=i+nft
333 imat=ixs(1,j)
334 phi(j)=pm(180+
nvar,imat)*lbuf%RHO(i)
335 END DO
336
337
338
339 ELSE
340#include "vectorize.inc"
341 DO i=lft,llt
342 j=i+nft
343 imat=ixq(1,j)
344 phi(j)=pm(180+
nvar,imat)*lbuf%RHO(i)
345 END DO
346 END IF
347 END IF
348 ELSE
349 DO i=lft,llt
350 j=i+nft
351 phi(j)=zero
352 ENDDO
353 ENDIF
354
355
356
357
358
359 IF(int22 > 0)THEN
360 nin = 1
361 piad22 => elbuf_tab(ng)%GBUF%TAG22(1:)
362 DO i=lft,llt
363 j = i+nft
364 ib = nint(piad22(i))
365 IF(ib==0)cycle
369 DO k=1,num
371 icellv =
brick_list(nin,ib)%SecndList%ICELLv(k)
373 ENDDO
374 enddo
375 ENDIF
376
377 ENDDO
378
379
380
381
382
383 ioff = 0
384 IF(nsegflu > 0)THEN
385 ioff = numels+numelq+numeltg
386 IF(nspmd > 1) THEN
387 ioff = ioff + nsvois
388 ENDIF
389 ngseg=nsegflu/nvsiz
390 IF(nsegflu-ngseg*nvsiz > 0)ngseg=ngseg+1
391 DO i=itask+1,ngseg,nthread
392 iseg=(i-1)*nvsiz
394
395 CASE(1)
396 IF(itrimat==0)THEN
397 DO j=iseg+1,
min(iseg+nvsiz,nsegflu)
398 phi(ioff+j)=segvar%RHO(j)
399 ENDDO
400 ELSE
401 DO j=iseg+1,
min(iseg+nvsiz,nsegflu)
402 phi(ioff+j)=segvar%PHASE_RHO(itrimat,j)
403 ENDDO
404 ENDIF
405
406 CASE(2)
407 IF(itrimat==0)THEN
408 DO j=iseg+1,
min(iseg+nvsiz,nsegflu)
409 phi(ioff+j)=segvar%EINT(j)
410 ENDDO
411 ELSE
412 DO j=iseg+1,
min(iseg+nvsiz,nsegflu)
413 phi(ioff+j)=segvar%PHASE_EINT(itrimat,j)
414 ENDDO
415 ENDIF
416
417 CASE(3)
418 DO j=iseg+1,
min(iseg+nvsiz,nsegflu)
419 phi(ioff+j)=segvar%RK(j)
420 ENDDO
421
422 CASE(4)
423 DO j=iseg+1,
min(iseg+nvsiz,nsegflu)
424 phi(ioff+j)=segvar%RE(j)
425 ENDDO
426
427 CASE(5)
428 DO j=iseg+1,
min(iseg+nvsiz,nsegflu)
429 phi(ioff+j)=segvar%UVAR(j)
430 ENDDO
431 END SELECT
432 ENDDO
433 ENDIF
434
436
437
438
439
440 IF (nspmd > 1) THEN
441
442 CALL spmd_e1vois(phi,nercvois,nesdvois,lercvois, lesdvois,lencom )
443
444 END IF
445
446
447
448
449
450
451
452 IF(debug(10) /= 0)THEN
453 IF(ncycle >= debug(10))THEN
454
455 cycle
456 ENDIF
457 ENDIF
458
459
460
461
462
463
464
465 IF(int22 > 0)THEN
466 nf1=nft+1+(nm-1)*numels
467 nfx=nft+(nm-1)*numels
469 1 phi ,
470 2 iflg ,
471 3 itrimat ,
nvar , itask ,
472 4 elbuf_tab, ixs , iparg)
473 ENDIF
474
475 DO ng=itask+1,ngroup,nthread
476
477 IF (iparg(76, ng) == 1) cycle
478 CALL varcondec(jcodv,iparg(34,ng),codtot)
479 IF (jcodv(
nvar) == 0) cycle
481 2 mtn ,llt ,nft ,iadr ,ity ,
482 3 npt ,jale ,ismstr ,jeul ,jtur ,
483 4 jthe ,jlag ,jmul ,jhbe ,jivf ,
484 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
485 6 irep ,iint ,igtyp ,israt ,isrot ,
486 7 icsen ,isorth ,isorthg ,ifailure,jsms )
487 isilent = iparg(64,ng)
488 IF (isilent == 1) cycle
489 IF (iparg(8,ng) == 1) cycle
490 IF (
max(1,jmul) < nm) cycle
491 IF (itrimat /= 0 .AND. mtn /= 51) cycle
492
493 isolnod = iparg(28,ng)
494
495
496
497
498 gbuf => elbuf_tab(ng)%GBUF
499 lbuf => elbuf_tab(ng)%BUFLY(nm)%LBUF(1,1,1)
500 mbuf => elbuf_tab(ng)%BUFLY(nm)%MAT(1,1,1)
501
502 IF (jmul /= 0) THEN
503 mtn =iparg(24+nm,ng)
504 ENDIF
505 lft=1
506
507
508
509
511 IF(itrimat == 0)THEN
512 prho => lbuf%RHO(1:llt)
513 ELSE
514
515 add0 = m51_n0phas + (itrimat-1)*m51_nvphas
516 add = add0 + 9
517 k = llt*(add-1)
518 prho => mbuf%VAR(k+1:k+llt)
519 END IF
520 var => prho
521
522
523
524 ELSEIF (
nvar == 2)
THEN
525 IF(itrimat == 0)THEN
526 peint=> lbuf%EINT(1:llt)
527 ELSE
528
529 add0 = m51_n0phas + (itrimat-1)*m51_nvphas
530 add = add0 + 8
531 k = llt*(add-1)
532 peint => mbuf%VAR(k+1:k+llt)
533 END IF
534 var => peint
535
536
537
538 ELSEIF (
nvar == 3)
THEN
539 var => elbuf_tab(ng)%BUFLY(nm)%LBUF(1,1,1)%RK(1:llt)
540
541
542
543 ELSEIF (
nvar == 4)
THEN
544 var => elbuf_tab(ng)%BUFLY(nm)%LBUF(1,1,1)%RE(1:llt)
545
546
547
548 ELSEIF (
nvar == 5)
THEN
549 var => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR(1:llt)
550
551
552
553 ELSEIF (
nvar == 6)
THEN
555 IF (mtn == 51 .AND. itrimat /= 0) THEN
556 var => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR(5*llt+1:6*llt)
557 ELSE
558 var => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR(llt+1:2*llt)
559 ENDIF
560 ELSE
561 var => elbuf_tab(ng)%GBUF%MOM( 1 : llt )
562 ENDIF
563
564
565
566 ELSEIF (
nvar == 7)
THEN
568 var => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR(2*llt+1:3*llt)
569 ELSE
570 var => elbuf_tab(ng)%GBUF%MOM( llt*1+1 : llt*1+llt )
571 ENDIF
572
573
574
575 ELSEIF (
nvar == 8)
THEN
577 var => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR(3*llt+1:4*llt)
578 ELSE
579 var => elbuf_tab(ng)%GBUF%MOM( llt*2+1 : llt*2+llt )
580 ENDIF
581
582
583
584 ELSEIF (
nvar == 9)
THEN
585 var => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR(4*llt+1:5*llt)
586 ENDIF
587
588
589
590
591 piad22 => elbuf_tab(ng)%GBUF%TAG22(1:)
592 IF (n2d == 0) THEN
593 nf1=nft+1+(nm-1)*numels
594 nfx=nft+(nm-1)*numels
595 pvol => lbuf%VOL(1:llt)
596 IF (isolnod /= 4) THEN
598 1 var , phi ,flux(6*nfx+1), flu1(nf1) ,ixs ,
599 2 ale_connect , ioff ,qmv(12*nfx+1), iflg ,
600 3 piad22 ,
nvar ,itask)
601 ELSE
603 1 var ,phi,flux(6*nfx+1),flu1(nf1),
604 2 ale_connect ,ioff )
605 ENDIF
606
607
608
609 ELSE
610 nf1=nft+1+(nm-1)*numelq
611 nfx=nft+(nm-1)*numelq
612 IF (nmult == 0) THEN
613 CALL aconv2(var ,phi ,flux(4*nfx+1),flu1(nf1),
614 . ale_connect ,qmv(8*nfx+1),iflg ,ixq ,
615 . x ,ioff )
616 ELSE
617 CALL bconv2(var, phi, flux(4*nfx+1), flu1(nf1), ale_connect ,bhole ,nm)
618 ENDIF
619 ENDIF
620
621 ENDDO
622
623
624
626
627 END DO
628
629
630 RETURN
subroutine a22conv3(phi, iflg, itrimat, nvar, itask, elbuf_tab, ixs, iparg)
subroutine a4conv3(vtot, phi, flux, flu1, ale_connect, ioff)
subroutine aconv2(vtot, phi, flux, flu1, ale_connect, qmv, iflg, ixq, x, ioff)
subroutine aconv3(vtot, phi, flux, flu1, ixs, ale_connect, ioff, qmv, iflg, tag22, nvar, itask)
subroutine bconv2(vtot, phi, flux, flu1, ale_connect, bhole, nm)
type(alefvm_param_), target alefvm_param
type(brick_entity), dimension(:,:), allocatable, target brick_list
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
integer function nvar(text)
subroutine spmd_e1vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
subroutine varcondec(icodv, varconv, codtot)