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