550# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
552# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
554# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
556# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
558# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
560# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
562# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
565 integer,
intent(in) :: patch_id
566 integer,
intent(in) ::
j,
k,
l
567 real(wp),
intent(in) :: eta
568#ifdef MFC_MIXED_PRECISION
569 integer(kind=1),
dimension(0:m,0:n,0:p),
intent(inout) :: patch_id_fp
571 integer,
dimension(0:m,0:n,0:p),
intent(inout) :: patch_id_fp
573 type(scalar_field),
dimension(1:sys_size),
intent(inout) :: q_prim_vf
581 real(wp) :: orig_gamma
582 real(wp) :: orig_pi_inf
586 real(wp) :: ys(1:num_species)
587 real(stp),
dimension(sys_size) :: orig_prim_vf
589 integer :: smooth_patch_id
591 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
594 orig_prim_vf(i) = q_prim_vf(i)%sf(
j,
k,
l)
597 if (mpp_lim .and. bubbles_euler)
then
600 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
604 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
605 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/
alf_sum%sf
609 call s_convert_to_mixture_variables(q_prim_vf,
j,
k,
l, orig_rho, orig_gamma, orig_pi_inf, orig_qv)
611 if (.not. igr .or. num_fluids > 1)
then
612 do i = eqn_idx%adv%beg, eqn_idx%adv%end
613 q_prim_vf(i)%sf(
j,
k,
l) = patch_icpp(patch_id)%alpha(i - eqn_idx%E)
617 if (mpp_lim .and. bubbles_euler)
then
620 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
624 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
625 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/
alf_sum%sf
629 do i = 1, eqn_idx%cont%end
630 q_prim_vf(i)%sf(
j,
k,
l) = patch_icpp(patch_id)%alpha_rho(i)
633 call s_convert_to_mixture_variables(q_prim_vf,
j,
k,
l, patch_icpp(patch_id)%rho, patch_icpp(patch_id)%gamma, &
634 & patch_icpp(patch_id)%pi_inf, patch_icpp(patch_id)%qv)
636 do i = 1, eqn_idx%cont%end
637 q_prim_vf(i)%sf(
j,
k,
l) = patch_icpp(smooth_patch_id)%alpha_rho(i)
640 if (.not. igr .or. num_fluids > 1)
then
641 do i = eqn_idx%adv%beg, eqn_idx%adv%end
642 q_prim_vf(i)%sf(
j,
k,
l) = patch_icpp(smooth_patch_id)%alpha(i - eqn_idx%E)
646 if (mpp_lim .and. bubbles_euler)
then
649 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
653 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
654 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/
alf_sum%sf
658 if (bubbles_euler)
then
660 mur = r0(i)*patch_icpp(smooth_patch_id)%r0/r0ref
661 muv = patch_icpp(smooth_patch_id)%v0
664 if (dist_type == 1)
then
665 q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(
j,
k,
l) = 1._wp
666 q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(
j,
k,
l) = mur
667 q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(
j,
k,
l) = muv
668 q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(
j,
k,
l) = mur**2 + (sigr*r0ref)**2
669 q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(
j,
k,
l) = mur*muv + rhorv*(sigr*r0ref)*(sigv*sqrt(p0ref/rho0ref))
670 q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(
j,
k,
l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
671 else if (dist_type == 2)
then
672 q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(
j,
k,
l) = 1._wp
673 q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(
j,
k,
l) = exp((sigr**2)/2._wp)*mur
674 q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(
j,
k,
l) = muv
675 q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(
j,
k,
l) = exp((sigr**2)*2._wp)*(mur**2)
676 q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(
j,
k,
l) = exp((sigr**2)/2._wp)*mur*muv
677 q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(
j,
k,
l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
680 q_prim_vf(qbmm_idx%rs(i))%sf(
j,
k,
l) = mur
681 q_prim_vf(qbmm_idx%vs(i))%sf(
j,
k,
l) = muv
682 if (.not. polytropic)
then
683 q_prim_vf(qbmm_idx%ps(i))%sf(
j,
k,
l) = patch_icpp(patch_id)%p0
684 q_prim_vf(qbmm_idx%ms(i))%sf(
j,
k,
l) = patch_icpp(patch_id)%m0
693 r3bar = r3bar + weight(i)*(q_prim_vf(qbmm_idx%rs(i))%sf(
j,
k,
l))**3._wp
695 q_prim_vf(eqn_idx%n)%sf(
j,
k,
l) = 3*q_prim_vf(eqn_idx%alf)%sf(
j,
k,
l)/(4*pi*r3bar)
699 call s_convert_to_mixture_variables(q_prim_vf,
j,
k,
l, patch_icpp(smooth_patch_id)%rho, &
700 & patch_icpp(smooth_patch_id)%gamma, patch_icpp(smooth_patch_id)%pi_inf, &
701 & patch_icpp(smooth_patch_id)%qv)
703 q_prim_vf(eqn_idx%E)%sf(
j,
k,
l) = (eta*patch_icpp(patch_id)%pres + (1._wp - eta)*orig_prim_vf(eqn_idx%E))
705 if (.not. igr .or. num_fluids > 1)
then
706 do i = eqn_idx%adv%beg, eqn_idx%adv%end
707 q_prim_vf(i)%sf(
j,
k,
l) = eta*patch_icpp(patch_id)%alpha(i - eqn_idx%E) + (1._wp - eta)*orig_prim_vf(i)
713 q_prim_vf(eqn_idx%B%beg)%sf(
j,
k,
l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg)
714 q_prim_vf(eqn_idx%B%beg + 1)%sf(
j,
k, &
715 &
l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg + 1)
717 q_prim_vf(eqn_idx%B%beg)%sf(
j,
k,
l) = eta*patch_icpp(patch_id)%Bx + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg)
718 q_prim_vf(eqn_idx%B%beg + 1)%sf(
j,
k, &
719 &
l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg + 1)
720 q_prim_vf(eqn_idx%B%beg + 2)%sf(
j,
k, &
721 &
l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg + 2)
725 if (hypoelasticity)
then
726 do i = 1, (eqn_idx%stress%end - eqn_idx%stress%beg) + 1
727 q_prim_vf(i + eqn_idx%stress%beg - 1)%sf(
j,
k, &
728 &
l) = (eta*patch_icpp(patch_id)%tau_e(i) + (1._wp - eta)*orig_prim_vf(i + eqn_idx%stress%beg - 1))
732 if (mpp_lim .and. bubbles_euler)
then
735 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
739 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
740 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/
alf_sum%sf
745 do i = 1, eqn_idx%cont%end
746 q_prim_vf(i)%sf(
j,
k,
l) = eta*patch_icpp(patch_id)%alpha_rho(i) + (1._wp - eta)*orig_prim_vf(i)
749 call s_convert_to_mixture_variables(q_prim_vf,
j,
k,
l, rho, gamma, pi_inf, qv)
751 do i = 1, eqn_idx%E - eqn_idx%mom%beg
752 q_prim_vf(i + eqn_idx%cont%end)%sf(
j,
k, &
753 &
l) = (eta*patch_icpp(patch_id)%vel(i) + (1._wp - eta)*orig_prim_vf(i + eqn_idx%cont%end))
758 real(wp) :: sum, term
761 do i = 1, num_species
762 term = eta*patch_icpp(patch_id)%Y(i) + (1._wp - eta)*patch_icpp(smooth_patch_id)%Y(i)
763 q_prim_vf(eqn_idx%species%beg + i - 1)%sf(
j,
k,
l) = term
767 if (sum < verysmall)
then
771 do i = 1, num_species
772 q_prim_vf(eqn_idx%species%beg + i - 1)%sf(
j,
k,
l) = q_prim_vf(eqn_idx%species%beg + i - 1)%sf(
j,
k,
l)/sum
773 ys(i) = q_prim_vf(eqn_idx%species%beg + i - 1)%sf(
j,
k,
l)
779 if (mixlayer_vel_profile)
then
780 q_prim_vf(1 + eqn_idx%cont%end)%sf(
j,
k, &
781 &
l) = (eta*patch_icpp(patch_id)%vel(1)*tanh(y_cc(
k)*mixlayer_vel_coef) + (1._wp - eta)*orig_prim_vf(1 &
782 & + eqn_idx%cont%end))
786 if (model_eqns == model_eqns_6eq)
then
787 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
788 q_prim_vf(i)%sf(
j,
k,
l) = q_prim_vf(eqn_idx%E)%sf(
j,
k,
l)
792 if (bubbles_euler)
then
794 mur = r0(i)*patch_icpp(patch_id)%r0/r0ref
795 muv = patch_icpp(patch_id)%v0
798 if (dist_type == 1)
then
799 q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(
j,
k,
l) = 1._wp
800 q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(
j,
k,
l) = mur
801 q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(
j,
k,
l) = muv
802 q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(
j,
k,
l) = mur**2 + (sigr*r0ref)**2
803 q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(
j,
k,
l) = mur*muv + rhorv*(sigr*r0ref)*(sigv*sqrt(p0ref/rho0ref))
804 q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(
j,
k,
l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
805 else if (dist_type == 2)
then
806 q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(
j,
k,
l) = 1._wp
807 q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(
j,
k,
l) = exp((sigr**2)/2._wp)*mur
808 q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(
j,
k,
l) = muv
809 q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(
j,
k,
l) = exp((sigr**2)*2._wp)*(mur**2)
810 q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(
j,
k,
l) = exp((sigr**2)/2._wp)*mur*muv
811 q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(
j,
k,
l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
814 q_prim_vf(qbmm_idx%rs(i))%sf(
j,
k,
l) = mur
815 q_prim_vf(qbmm_idx%vs(i))%sf(
j,
k,
l) = muv
817 if (.not. polytropic)
then
818 q_prim_vf(qbmm_idx%ps(i))%sf(
j,
k,
l) = patch_icpp(patch_id)%p0
819 q_prim_vf(qbmm_idx%ms(i))%sf(
j,
k,
l) = patch_icpp(patch_id)%m0
828 r3bar = r3bar + weight(i)*(q_prim_vf(qbmm_idx%rs(i))%sf(
j,
k,
l))**3._wp
830 q_prim_vf(eqn_idx%n)%sf(
j,
k,
l) = 3*q_prim_vf(eqn_idx%alf)%sf(
j,
k,
l)/(4*pi*r3bar)
834 if (mpp_lim .and. bubbles_euler)
then
837 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
841 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
842 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/
alf_sum%sf
846 if (bubbles_euler .and. (.not. polytropic) .and. (.not. qbmm))
then
848 if (f_is_default(real(q_prim_vf(qbmm_idx%ps(i))%sf(
j,
k,
l), kind=wp)))
then
849 q_prim_vf(qbmm_idx%ps(i))%sf(
j,
k,
l) = pb0(i)
851 if (f_is_default(real(q_prim_vf(qbmm_idx%ms(i))%sf(
j,
k,
l), kind=wp)))
then
852 q_prim_vf(qbmm_idx%ms(i))%sf(
j,
k,
l) = mass_v0(i)
857 if (surface_tension)
then
858 q_prim_vf(eqn_idx%c)%sf(
j,
k,
l) = eta*patch_icpp(patch_id)%cf_val + (1._wp - eta)*orig_prim_vf(eqn_idx%c)
861 if (1._wp - eta < 1.e-16_wp) patch_id_fp(
j,
k,
l) = patch_id