212
213
214
220 USE glob_therm_mod
221
222
223
224#include "implicit_f.inc"
225
226
227
228#include "mvsiz_p.inc"
229
230
231
232#include "com01_c.inc"
233#include "com04_c.inc"
234#include "com_xfem1.inc"
235#include "param_c.inc"
236#include "units_c.inc"
237#include "scr03_c.inc"
238#include "scr06_c.inc"
239#include "scr07_c.inc"
240#include "scr14_c.inc"
241#include "scr16_c.inc"
242#include "parit_c.inc"
243#include "task_c.inc"
244#include "scrnoi_c.inc"
245#include "scrfs_c.inc"
246#include "scrcut_c.inc"
247#include "scr_fac_c.inc"
248#include "sphcom.inc"
249#include "spmd_c.inc"
250#include "tabsiz_c.inc"
251#include "scr17_c.inc"
252#include "sms_c.inc"
253
254
255
256 TYPE(H3D_DATABASE) :: H3D_DATA
257 TYPE(PINCH) :: PINCH_DATA
258 type (glob_therm_) ,intent(inout) :: GLOB_THERM
259
260
261
262 INTEGER I,NVAR,M16STAK,NPE,NIPMAX,NPSAV_OLD
264
265
266 pinch_data%SAPINCH = 0
267
268 IF(iparit==-1)iparit=ipari0
269
270 IF(icrack3d > 0)THEN
271 IF(iparit /= 1) iparit = ipari0
272 ENDIF
273
274 IF(ipari0==0.AND.iparit==1) THEN
275 IF(ispmd==0)THEN
276 WRITE(istdo,*)' **WARNING PARALLEL ARITHMETIC DISABLED'
277 WRITE(iout,*)' **WARNING PREVIOUS RUN WITHOUT PARITH/ON'
278 WRITE(iout,*)' **PARALLEL ARITHMETIC IS NO MORE ACTIVABLE'
279 ENDIF
280 iparit=0
281 ENDIF
282
283 nisky0 = 8*numels + 4*numelq + 4*numelc + 2*numelt +
284 . 2*numelp + 3*numelr + 3*numeltg +
285 . 6*numels10 + 12*numels20 + 8*numels16 + 3*numeltg6
286 lcnel = nisky0
287
288 nisky0 = nisky0 + 4*nskymv0
289
290 nisky0 = nisky0 + 4*nconld
291
292 nisky0 = nisky0 + 4*glob_therm%NUMCONV + 4*glob_therm%NUMRADIA + 4*glob_therm%NFXFLUX
293 nisky0 = nisky0 + slloadp
294
295 IF(iparit>=1) iparit=1
296 IF( lwamp /= 0 .AND. lwanmp/=0)THEN
297 lwamp =
max(lwamp,2*mvsiz*100)
298 lenwa =
max( nthread * lwamp,lwanmp)
299 ENDIF
300 swa = lenwa
301 sfv = nfunct
302 sicodt=numnod+2
303 sicodr=numnod*iroddl
304
305
306
307
308
309
310
311 npsav_old = npsav
312 IF(npsav==0)npsav_old = 23
313 npsav = 29
314 IF(iparit==3)THEN
315 sa = 3*numnod+9*numnod*nthread
316 sar = 3*numnod+9*numnod*nthread
317 sstifn = numnod+3*numnod*nthread
318 sviscn = numnod+3*numnod*nthread
319 sstifr = numnod*iroddl+3*numnod*nthread*iroddl
320 sdmsph = 0
321 spartsav = npsav*(npart+nthpart)*nthread
322 sfsky = 0
323 sfskym = 0
324 sfskyd = 0
325 sisky = 0
326 probint=0.5
327 lskyi_sms =
max(nint(5*
max(4*numnod,imaximp)*probint)+4*(numsph+nskyi18)+lcni2,isumnx)
328 sadsky = 0
329 sprocne = 0
330 saddcni2 = 0
331 sprocni2 = 0
332 siadsdp = 0
333 siadrcp = 0
334 siads = 0
335 siadwal = 0
336 siadrbk = 0
337 siadi2 = 0
338 siadmv2 = 0
339 siadmv3 = 0
340 siadll = 0
341 siadrbm = 0
342 siadi18 = 0
343 siadrbmk = 0
344 saddcncnd = 0
345 sprocncnd = 0
346 siadcnd = 0
347 ELSEIF(iparit/=0)THEN
348 sa = 3*numnod
349 sar = 3*numnod
350 sstifn = numnod
351 sviscn = numnod
352 sstifr = numnod
353 IF(sol2sph_flag/=0) THEN
354 sdmsph = numnod
355 ELSE
356 sdmsph = 0
357 END IF
358 spartsav = npsav*(npart+nthpart)*nthread
359
360 lsky = lcne0
361 sfsky = 8*lcne0
362
363 lskypxfem = lcnepxfem
364
365 lskycrkxfem = lcnecrkxfem
366
367 IF(iale+ieuler+glob_therm%ITHERM+ialelag/=0) THEN
368 sfskym = lcne0
369 ELSE
370 sfskym = 0
371 ENDIF
372
373 IF(sol2sph_flag/=0) THEN
374 sfskyd = lcne0
375 ELSE
376 sfskyd = 0
377 ENDIF
378
379 probint=0.5
380
381 lskyi =
max(nint(5*
max(4*numnod,imaximp)*probint)
382 + +4*(numsph+nskyi18),isumnx)
383 sfskyi = nfskyi*lskyi
384 sisky = lskyi
385
386 lskyi_sms = lskyi+lcni2
387
388 sadsky = numnod + 1
389
390 sadsky = sadsky + numnod
391 sprocne = lcne0
392 sprocne_pxfe = lcnepxfem
393 sprocne_crkxfe = lcnecrkxfem
394
395 IF (i2nsnt>0) THEN
396 saddcni2 = numnod+1
397
398 IF(ivector==1) saddcni2 = saddcni2 + numnod
399 ELSE
400 saddcni2 = 0
401 ENDIF
402
403 sprocni2 = lcni2
404 siadsdp = nspmd+1
405 siadrcp = nspmd+1
406
407
408
409
410
411
412
413
414
415 siads = nisky0
416 siadwal = nskyrw0
417 siadrbk = nskyrbk0
418 siadi2 = niskyi2
419 siadmv2 = nskymv0
420 siadmv3 = nskymvc0
421 siadll = nskyll0
422 siadrbm = nskyrbm0
423 siadi18 = nskyi18
424 siadrbmk = nskyrbmk0
425 ELSE
426 sa = 3*numnod*nthread
427 sar = 3*numnod*nthread
428 sstifn = numnod*nthread
429
431 pinch_data%SAPINCH = nthread*numnod
432 ELSE
433 pinch_data%SAPINCH = 0
434 ENDIF
435
436 IF(sol2sph_flag/=0) THEN
437 sdmsph = numnod*nthread
438 ELSE
439 sdmsph = 0
440 END IF
441
442 sviscn = numnod*nthread
443 sstifr = numnod*iroddl*nthread
444 spartsav = npsav*(npart+nthpart)*nthread
445 sfsky = 0
446 sfskym = 0
447 sfskyd = 0
448 sisky = 0
449
450 probint=0.5
451 lskyi_sms =
max(nint(5*
max(4*numnod,imaximp)*probint)
452 + +4*(numsph+nskyi18)+lcni2,isumnx)
453
454 sadsky = 0
455 sprocne = 0
456 saddcni2 = 0
457 sprocni2 = 0
458 siadsdp = 0
459 siadrcp = 0
460 siads = 0
461 siadwal = 0
462 siadrbk = 0
463 siadi2 = 0
464 siadmv2 = 0
465 siadmv3 = 0
466 siadll = 0
467 siadrbm = 0
468 siadi18 = 0
469 sprocne_pxfe = 0
470 sprocne_crkxfe = 0
471 ENDIF
472
473 IF (ns10e >0 .AND. ipari0 /= 0) THEN
474 saddcncnd = numnod + 1
475 sprocncnd = lcncnd
476 siadcnd = 2*ns10e
477 ELSE
478 saddcncnd = 0
479 sprocncnd = 0
480 siadcnd = 0
481 END IF
482
483 IF(
ale%GLOBAL%INCOMP==0)
THEN
484 sval2=
max(iale,glob_therm%ITHERM,ieuler,ialelag)*(numels+numelq+numeltg+nsvois+nqvois+ntgvois)*
max(1,nmult)
485
486 sphi =
max(iale,glob_therm%ITHERM,ieuler,ialelag)*( numels + numelq + numeltg + nsvois + nqvois + ntgvois + nsegflu )
487 ELSE
488 sval2 = 0
489 sphi = 0
490 ENDIF
491 sr = 0
492 sestif = 0
493
494
495
496
497 silink=4*nrlink
498 sfr_rl = (nspmd+2)*nrlink
499
500
501 sllink=lllink
502 siadrl = lllink
503
504
505
506
507 scrflsw = 9*nsflsw
508 sflsw = 6*nsflsw
509 sneflsw = 1*nsflsw
510 snnflsw = 8*ntflsw
511
512
513
514
515 sfani = 3*numnod*(
516 .
min(1,anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT)
517 . +
min(1,anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT)
518 . +
min(1,anim_v(6)+outp_v(6)+h3d_data%N_VECT_FEXT) )
519 . + 6*(nsect+nrbody+nrwall)
520 . + 6*numnod*
min(1,anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT)
521 . + 3*numnod*
min(1,anim_v(13)+h3d_data%N_VECT_CONT2)
522 . + 6*numnod*
min(1,anim_v(27)+h3d_data%N_VECT_PCONT2)
523
524 sxcut = 7*ncuts
525 sanin = numnod*(
526 .
min(1,anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT)
527 . +
min(1,anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS)
528 . +
min(1,anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER))
529 . + numelr*(anim_fe(11)+anim_fe(12)+anim_fe(13)) + 2*numnod*
min(1,anim_n(15)*anim_n(16)+h3d_data%N_SCAL_DAMA2)
530 stani = 6*(numelc+numeltg)*iepsdot + 15*(numelt+numelp+numelr)*(
max(anim_ft(1),h3d_data%UND_FORC))
531
532 ssecfcum = 7*numnod*nsect*isecut
533
534 swasph = lwasph
535
536
540 IF(anim_se(10) == 1 .OR. h3d_data%SOL_SCAL_VORTX == 1)
fani_cell%IS_VORT_X_REQUESTED=.true.
541 IF(anim_se(4960) == 1 .OR. h3d_data%SOL_SCAL_VORTY == 1)
fani_cell%IS_VORT_Y_REQUESTED=.true.
542 IF(anim_se(4961) == 1 .OR. h3d_data%SOL_SCAL_VORTZ == 1)
fani_cell%IS_VORT_Z_REQUESTED=.true.
543
544
545
547 IF(h3d_data%N_VECT_CONT == 1)
fani_cell%IS_F18_FVM_REQUESTED = .true.
548
549 m16stak = 0
550 IF(numels16/=0)THEN
551 npe = 16
552 nipmax = 81
553 m16stak = (11*nipmax+15*npe+3*nipmax*npe)*mvsiz
554 ENDIF
555 IF(numels20/=0)THEN
556 npe = 20
557 nipmax = 81
558 m16stak =
max(m16stak,(10*nipmax+15*npe+3*nipmax*npe)*mvsiz)
559 ENDIF
560 npsav = npsav_old
561
562 IF(numels8a>0)THEN
563 nipmax = 729
564 m16stak =
max(m16stak,12*nipmax*mvsiz)
565 ENDIF
566 sw16 = m16stak * nthread
567 sicut= 44*ncuts
568
569
570
571
572
573
574 sdretrio = 5*ninter
575 slbvrs = 21*nibvel
576
577
578
579 IF(nnoise==0)THEN
580 nnoise=nnoiser*rnoi
582 ELSE
583 IF((noisev+noisea+noisep)==0) noisev = 1
584 nvar=3*noisev+3*noisea+noisep
585 ENDIF
586 if01=1
587 mf01=1
588 ifif=if01
589 mfif=mf01
590 sinoise = 0
591 sfnoise = 0
592 IF(nnoise>0)THEN
593 ifif = (2*nnoise+10)
594 mfif = (6*
nvar*nnoise+1)
595 sinoise = 2*nnoise+10
596 sfnoise = 6*
nvar*nnoise+1
597 ENDIF
598 nnoise_sav = nnoise
599
600
601
602 RETURN
type(fani_cell_) fani_cell
integer function nvar(text)