299
305
306 implicit none
307
308 class(LocalMesh3D), intent(in) :: lmesh
309 class(ElementBase3D), intent(in) :: elem
310 class(LocalMesh2D), intent(in) :: lmesh2D
311 class(ElementBase2D), intent(in) :: elem2D
312 real(RP), intent(out) :: DENS_dt(elem%Np,lmesh%NeA)
313 real(RP), intent(out) :: MOMX_dt(elem%Np,lmesh%NeA)
314 real(RP), intent(out) :: MOMY_dt(elem%Np,lmesh%NeA)
315 real(RP), intent(out) :: MOMZ_dt(elem%Np,lmesh%NeA)
316 real(RP), intent(out) :: ETOT_dt(elem%Np,lmesh%NeA)
317 real(RP), intent(in) :: DDENS_(elem%Np,lmesh%NeA)
318 real(RP), intent(in) :: MOMX_(elem%Np,lmesh%NeA)
319 real(RP), intent(in) :: MOMY_(elem%Np,lmesh%NeA)
320 real(RP), intent(in) :: MOMZ_(elem%Np,lmesh%NeA)
321 real(RP), intent(in) :: ETOT_(elem%Np,lmesh%NeA)
322 real(RP), intent(in) :: DENS_hyd(elem%Np,lmesh%NeA)
323 real(RP), intent(in) :: PRES_hyd(elem%Np,lmesh%NeA)
324 real(RP), intent(in) :: DDENS0_(elem%Np,lmesh%NeA)
325 real(RP), intent(in) :: MOMX0_(elem%Np,lmesh%NeA)
326 real(RP), intent(in) :: MOMY0_(elem%Np,lmesh%NeA)
327 real(RP), intent(in) :: MOMZ0_(elem%Np,lmesh%NeA)
328 real(RP), intent(in) :: ETOT0_(elem%Np,lmesh%NeA)
329 real(RP), intent(in) :: Rtot(elem%Np,lmesh%NeA)
330 real(RP), intent(in) :: CVtot(elem%Np,lmesh%NeA)
331 real(RP), intent(in) :: CPtot(elem%Np,lmesh%NeA)
332 class(ElementOperationBase3D), intent(in) :: element3D_operation
333 class(SparseMat), intent(in) :: Dz, Lift
334 real(RP), intent(in) :: impl_fac
335 real(RP), intent(in) :: dt
336
337 real(RP) :: PROG_VARS (elem%Np,lmesh%NeZ,PRGVAR_NUM,lmesh%NeX*lmesh%NeY)
338 real(RP) :: DPRES (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
339 real(RP) :: PROG_VARS0(elem%Np,lmesh%NeZ,PRGVAR_NUM,lmesh%NeX*lmesh%NeY)
340 real(RP) :: DPRES0 (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
341 real(RP) :: b1D(3,elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2,lmesh%NeX*lmesh%NeY)
342 real(RP) :: GeoPot (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
343 real(RP) :: KinHovDENS(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
344 integer :: ipiv(elem%Nnode_v*3*lmesh%NeZ,elem%Nnode_h1D**2)
345 real(RP) :: b1D_uv(elem%Nnode_v,lmesh%NeZ,2,elem%Nnode_h1D**2,lmesh%NeX*lmesh%NeY)
346 integer :: ipiv_uv(elem%Nnode_v*1*lmesh%NeZ,elem%Nnode_h1D**2)
347 real(RP) :: alph(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
348 real(RP) :: Rtot_z(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
349 real(RP) :: CPtot_ov_CVtot(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
350 real(RP) :: DENS_hyd_z(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
351 real(RP) :: PRES_hyd_z(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
352 real(RP) :: GnnM_z(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
353 real(RP) :: G13_z(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
354 real(RP) :: G23_z(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
355 real(RP) :: GsqrtV_z(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
356 real(RP) :: nz(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
357 integer :: vmapM(elem%NfpTot,lmesh%NeZ)
358 integer :: vmapP(elem%NfpTot,lmesh%NeZ)
359 integer :: ColMask(elem%Nnode_v)
360 integer :: ke_xy, ke_z, ke, ke2D, v
361 integer :: itr_nlin
362 integer :: kl, ku, nz_1D
363 integer :: kl_uv, ku_uv, nz_1D_uv
364 integer :: ij, info
365 logical :: is_converged
366
367 real(RP), allocatable :: PmatBnd(:,:,:)
368 real(RP), allocatable :: PmatBnd_uv(:,:,:)
369
370 real(RP) :: DENS_(elem%Np)
371
372
373 call prof_rapstart( 'hevi_cal_vi_prep', 3)
374
375 nz_1d = elem%Nnode_v * 3 * lmesh%NeZ
376 kl = ( elem%Nnode_v + 1 ) * 3 - 1
377 ku = kl
378 nz_1d_uv = elem%Nnode_v * 1 * lmesh%NeZ
379 kl_uv = elem%Nnode_v
380 ku_uv = kl_uv
381 allocate( pmatbnd(2*kl+ku+1,nz_1d,elem%Nnode_h1D**2) )
382 allocate( pmatbnd_uv(2*kl_uv+ku_uv+1,nz_1d_uv,elem%Nnode_h1D**2) )
383
384 call lmesh%GetVmapZ1D( vmapm, vmapp )
385
386
387
388
389
390 do ke_xy=1, lmesh%NeX*lmesh%NeY
391 do ke_z=1, lmesh%NeZ
392 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
393 ke2d = lmesh%EMap3Dto2D(ke)
394
395 prog_vars(:,ke_z,dens_vid,ke_xy) = ddens0_(:,ke)
396 prog_vars(:,ke_z,momx_vid,ke_xy) = momx0_(:,ke)
397 prog_vars(:,ke_z,momy_vid,ke_xy) = momy0_(:,ke)
398 prog_vars(:,ke_z,momz_vid,ke_xy) = momz0_(:,ke)
399 prog_vars(:,ke_z,etot_vid,ke_xy) = etot0_(:,ke)
400
401 dens_hyd_z(:,ke_z,ke_xy) = dens_hyd(:,ke)
402 pres_hyd_z(:,ke_z,ke_xy) = pres_hyd(:,ke)
403 geopot(:,ke_z,ke_xy) = grav * lmesh%zlev(:,ke)
404
405 dens_(:) = dens_hyd(:,ke) + ddens0_(:,ke)
406 kinhovdens(:,ke_z,ke_xy) = 0.5_rp * ( &
407 momx0_(:,ke) * ( lmesh%G_ij(elem%IndexH2Dto3D,ke2d,1,1) * momx0_(:,ke) + lmesh%G_ij(elem%IndexH2Dto3D,ke2d,2,1) * momy0_(:,ke) ) &
408 + momy0_(:,ke) * ( lmesh%G_ij(elem%IndexH2Dto3D,ke2d,2,1) * momx0_(:,ke) + lmesh%G_ij(elem%IndexH2Dto3D,ke2d,2,2) * momy0_(:,ke) ) &
409 ) / dens_(:)**2
410
411
412 rtot_z(:,ke_z,ke_xy) = rtot(:,ke)
413 cptot_ov_cvtot(:,ke_z,ke_xy) = cptot(:,ke) / cvtot(:,ke)
414
415 dpres(:,ke_z,ke_xy) = &
416 ( cptot_ov_cvtot(:,ke_z,ke_xy) - 1.0_rp ) &
417 * ( etot0_(:,ke) - ( dens_(:) * ( kinhovdens(:,ke_z,ke_xy) + geopot(:,ke_z,ke_xy) ) + 0.5_rp * momz0_(:,ke)**2 / dens_(:) ) ) &
418 - pres_hyd(:,ke)
419
420 nz(:,ke_z,ke_xy) = lmesh%normal_fn(:,ke,3)
421 g13_z(:,ke_z,ke_xy) = lmesh%GI3(:,ke,1)
422 g23_z(:,ke_z,ke_xy) = lmesh%GI3(:,ke,2)
423 gsqrtv_z(:,ke_z,ke_xy) = lmesh%Gsqrt(:,ke) / lmesh%GsqrtH(elem%IndexH2Dto3D,ke2d)
424
425 gnnm_z(:,ke_z,ke_xy) = ( 1.0_rp / gsqrtv_z(:,ke_z,ke_xy)**2 &
426 + g13_z(:,ke_z,ke_xy)**2 + g23_z(:,ke_z,ke_xy) )
427 end do
428 end do
429
430
431 prog_vars0(:,:,:,:) = prog_vars(:,:,:,:)
432 dpres0(:,:,:) = dpres(:,:,:)
433
434
435
436 call prof_rapend( 'hevi_cal_vi_prep', 3)
437
438
439
440 if ( abs(impl_fac) > 0.0_rp ) then
441 call prof_rapstart( 'hevi_cal_vi_itr', 3)
442
443
444
445 do itr_nlin = 1, 1
446 call prof_rapstart( 'hevi_cal_vi_ax', 3)
447
448 call vi_eval_ax_uv( &
449 momx_dt(:,:), momy_dt(:,:), alph(:,:,:), &
450 prog_vars, dpres, prog_vars0, dpres0, &
451 ddens_, momx_, momy_, momz_, etot_, &
452 dens_hyd_z, pres_hyd_z, &
453 rtot_z, cptot_ov_cvtot, &
454 dz, lift, intrpmat_vpordm1, &
455 gnnm_z, g13_z, g23_z, gsqrtv_z, &
456 impl_fac, dt, &
457 lmesh, elem, nz, vmapm, vmapp, &
458 b1d_uv(:,:,:,:,:) )
459
460 call prof_rapend( 'hevi_cal_vi_ax', 3)
461
462 do ke_xy=1, lmesh%NeX * lmesh%NeY
463 call prof_rapstart( 'hevi_cal_vi_matbnd', 3)
464 call vi_construct_matbnd_uv( pmatbnd_uv(:,:,:), &
465 kl_uv, ku_uv, nz_1d_uv, &
466 prog_vars(:,:,:,ke_xy), kinhovdens(:,:,ke_xy), &
467 dens_hyd_z(:,:,ke_xy), pres_hyd_z(:,:,ke_xy), &
468 g13_z(:,:,ke_xy), g23_z(:,:,ke_xy), gsqrtv_z(:,:,ke_xy), &
469 alph(:,:,ke_xy), &
470 rtot_z(:,:,ke_xy), cptot_ov_cvtot(:,:,ke_xy), &
471 geopot(:,:,ke_xy), &
472 dz, lift, intrpmat_vpordm1, &
473 impl_fac, dt, &
474 lmesh, elem, nz(:,:,ke_xy), vmapm, vmapp, ke_xy, 1 )
475 call prof_rapend( 'hevi_cal_vi_matbnd', 3)
476
477 call prof_rapstart( 'hevi_cal_vi_lin', 3)
478
479
480 do ij=1, elem%Nnode_h1D**2
481 call dgbsv( nz_1d_uv, kl_uv, ku_uv, 2, pmatbnd_uv(:,:,ij), 2*kl_uv+ku_uv+1, ipiv_uv(:,ij), b1d_uv(:,:,:,ij,ke_xy), nz_1d_uv, info)
482
483 colmask(:) = elem%Colmask(:,ij)
484 do ke_z=1, lmesh%NeZ
485 prog_vars(colmask(:),ke_z,momx_vid,ke_xy) = prog_vars(colmask(:),ke_z,momx_vid,ke_xy) + b1d_uv(:,ke_z,1,ij,ke_xy)
486 prog_vars(colmask(:),ke_z,momy_vid,ke_xy) = prog_vars(colmask(:),ke_z,momy_vid,ke_xy) + b1d_uv(:,ke_z,2,ij,ke_xy)
487 end do
488 end do
489
490
491 call prof_rapend( 'hevi_cal_vi_lin', 3)
492
493 end do
494
495 call prof_rapstart( 'hevi_cal_vi_ax', 3)
496 call vi_eval_ax( &
497 dens_dt(:,:), momz_dt(:,:), etot_dt(:,:), &
498 alph(:,:,:), &
499 prog_vars, dpres, prog_vars0, dpres0, &
500 ddens_, momx_, momy_, momz_, etot_, &
501 dens_hyd_z, pres_hyd_z, &
502 rtot_z, cptot_ov_cvtot, &
503 dz, lift, intrpmat_vpordm1, &
504 gnnm_z, g13_z, g23_z, gsqrtv_z, &
505 impl_fac, dt, &
506 lmesh, elem, nz, vmapm, vmapp, &
507 b1d(:,:,:,:,:) )
508 call prof_rapend( 'hevi_cal_vi_ax', 3)
509
510 do ke_xy=1, lmesh%NeX * lmesh%NeY
511 call prof_rapstart( 'hevi_cal_vi_matbnd', 3)
512 call vi_construct_matbnd( pmatbnd(:,:,:), &
513 kl, ku, nz_1d, &
514 prog_vars(:,:,:,ke_xy), kinhovdens(:,:,ke_xy), &
515 dens_hyd_z(:,:,ke_xy), pres_hyd_z(:,:,ke_xy), &
516 g13_z(:,:,ke_xy), g23_z(:,:,ke_xy), gsqrtv_z(:,:,ke_xy), &
517 alph(:,:,ke_xy), &
518 rtot_z(:,:,ke_xy), cptot_ov_cvtot(:,:,ke_xy), &
519 geopot(:,:,ke_xy), &
520 dz, lift, intrpmat_vpordm1, &
521 impl_fac, dt, &
522 lmesh, elem, nz(:,:,ke_xy), vmapm, vmapp, ke_xy, 1 )
523 call prof_rapend( 'hevi_cal_vi_matbnd', 3)
524
525 call prof_rapstart( 'hevi_cal_vi_lin', 3)
526
527
528 do ij=1, elem%Nnode_h1D**2
529 call dgbsv( nz_1d, kl, ku, 1, pmatbnd(:,:,ij), 2*kl+ku+1, ipiv(:,ij), b1d(:,:,:,ij,ke_xy), nz_1d, info)
530
531 colmask(:) = elem%Colmask(:,ij)
532 do ke_z=1, lmesh%NeZ
533 prog_vars(colmask(:),ke_z,dens_vid,ke_xy) = prog_vars(colmask(:),ke_z,dens_vid,ke_xy) + b1d(1,:,ke_z,ij,ke_xy)
534 prog_vars(colmask(:),ke_z,momz_vid,ke_xy) = prog_vars(colmask(:),ke_z,momz_vid,ke_xy) + b1d(2,:,ke_z,ij,ke_xy)
535 prog_vars(colmask(:),ke_z,etot_vid,ke_xy) = prog_vars(colmask(:),ke_z,etot_vid,ke_xy) + b1d(3,:,ke_z,ij,ke_xy)
536 end do
537 end do
538
539
540 do ke_z=1, lmesh%NeZ
541 dens_(:) = dens_hyd_z(:,ke_z,ke_xy) + prog_vars(:,ke_z,dens_vid,ke_xy)
542 dpres(:,ke_z,ke_xy) = &
543 ( cptot_ov_cvtot(:,ke_z,ke_xy) - 1.0_rp ) &
544 * ( prog_vars(:,ke_z,etot_vid,ke_xy) &
545 - ( dens_(:) * ( kinhovdens(:,ke_z,ke_xy) + geopot(:,ke_z,ke_xy) ) + 0.5_rp * prog_vars(:,ke_z,momz_vid,ke_xy)**2 / dens_(:) ) ) &
546 - pres_hyd_z(:,ke_z,ke_xy)
547 end do
548
549 call prof_rapend( 'hevi_cal_vi_lin', 3)
550
551 end do
552 end do
553
554 call prof_rapend( 'hevi_cal_vi_itr', 3)
555 end if
556
557 call prof_rapstart( 'hevi_cal_vi_retrun_var', 3)
558 if ( abs(impl_fac) > 0.0_rp) then
559
560 do ke_xy=1, lmesh%NeX * lmesh%NeY
561 do ke_z=1, lmesh%NeZ
562 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
563 dens_dt(:,ke) = ( prog_vars(:,ke_z,dens_vid,ke_xy) - ddens_(:,ke) ) / impl_fac
564 momx_dt(:,ke) = ( prog_vars(:,ke_z,momx_vid,ke_xy) - momx_(:,ke) ) / impl_fac
565 momy_dt(:,ke) = ( prog_vars(:,ke_z,momy_vid,ke_xy) - momy_(:,ke) ) / impl_fac
566 momz_dt(:,ke) = ( prog_vars(:,ke_z,momz_vid,ke_xy) - momz_(:,ke) ) / impl_fac
567 etot_dt(:,ke) = ( prog_vars(:,ke_z,etot_vid,ke_xy) - etot_(:,ke) ) / impl_fac
568 end do
569 end do
570 else
571 call vi_eval_ax_uv( &
572 momx_dt(:,:), momy_dt(:,:), alph(:,:,:), &
573 prog_vars, dpres, prog_vars0, dpres0, &
574 ddens_, momx_, momy_, momz_, etot_, &
575 dens_hyd_z, pres_hyd_z, &
576 rtot_z, cptot_ov_cvtot, &
577 dz, lift, intrpmat_vpordm1, &
578 gnnm_z, g13_z, g23_z, gsqrtv_z, &
579 impl_fac, dt, &
580 lmesh, elem, nz, vmapm, vmapp )
581
582 call vi_eval_ax( &
583 dens_dt(:,:), momz_dt(:,:), etot_dt(:,:), &
584 alph(:,:,:), &
585 prog_vars, dpres, prog_vars0, dpres0, &
586 ddens_, momx_, momy_, momz_, etot_, &
587 dens_hyd_z, pres_hyd_z, &
588 rtot_z, cptot_ov_cvtot, &
589 dz, lift, intrpmat_vpordm1, &
590 gnnm_z, g13_z, g23_z, gsqrtv_z, &
591 impl_fac, dt, &
592 lmesh, elem, nz, vmapm, vmapp )
593 end if
594 call prof_rapend( 'hevi_cal_vi_retrun_var', 3)
595
596 return
module FElib / Fluid dyn solver / Atmosphere / Nonhydrostatic model / HEVI / Common
subroutine, public atm_dyn_dgm_nonhydro3d_etot_hevi_common_construct_matbnd(pmatbnd, kl, ku, nz_1d, prog_vars0, kinhovdens00, dens_hyd, pres_hyd, g13, g23, gsqrtv, alph, rtot, cptot_ov_cvtot, geopot, dz, lift, intrpmat_vpordm1, impl_fac, dt, lmesh, elem, nz, vmapm, vmapp, ke_x, ke_y)
subroutine, public atm_dyn_dgm_nonhydro3d_etot_hevi_common_eval_ax(dens_t, momz_t, etot_t, alph, prog_vars, dpres, prog_vars0, dpres0, ddens00, momx00, momy00, momz00, entot00, dens_hyd, pres_hyd, rtot, cptot_ov_cvtot, dz, lift, intrpmat_vpordm1, gnnm, g13, g23, gsqrtv, impl_fac, dt, lmesh, elem, nz, vmapm, vmapp, b1d_ij)
subroutine, public atm_dyn_dgm_nonhydro3d_etot_hevi_common_eval_ax_uv(momx_t, momy_t, alph, prog_vars, dpres, prog_vars0, dpres0, ddens00, momx00, momy00, momz00, entot00, dens_hyd, pres_hyd, rtot, cptot_ov_cvtot, dz, lift, intrpmat_vpordm1, gnnm, g13, g23, gsqrtv, impl_fac, dt, lmesh, elem, nz, vmapm, vmapp, b1d_ij_uv)
subroutine, public atm_dyn_dgm_nonhydro3d_etot_hevi_common_construct_matbnd_uv(pmatbnd_uv, kl_uv, ku_uv, nz_1d_uv, prog_vars0, kinhovdens00, dens_hyd, pres_hyd, g13, g23, gsqrtv, alph, rtot, cptot_ov_cvtot, geopot, dz, lift, intrpmat_vpordm1, impl_fac, dt, lmesh, elem, nz, vmapm, vmapp, ke_x, ke_y)