src: bundle pre_process initial-condition state into ic_context

Author: sbryngelson

src/common/m_derived_types.fpp

@@ -154,6 +154,21 @@ module m_derived_types
         integer               :: psi      !< Psi variable equation
     end type eqn_idx_info
 
+    !> Initial-condition state assembled by pre_process: working primitive and
+    !> conservative fields, temperature, boundary-condition types, and the
+    !> patch-identity bookkeeping array.
+    type ic_context
+        type(scalar_field), allocatable, dimension(:)    :: q_prim_vf  !< Primitive variables
+        type(scalar_field), allocatable, dimension(:)    :: q_cons_vf  !< Conservative variables
+        type(scalar_field)                               :: q_T_sf     !< Temperature field
+        type(integer_field), allocatable, dimension(:,:) :: bc_type    !< Boundary-condition type fields
+#ifdef MFC_MIXED_PRECISION
+        integer(kind=1), allocatable, dimension(:,:,:) :: patch_id_fp  !< Patch identities bookkeeping
+#else
+        integer, allocatable, dimension(:,:,:) :: patch_id_fp  !< Patch identities bookkeeping
+#endif
+    end type ic_context
+
     type bc_patch_parameters
         integer                :: geometry
         integer                :: type

src/pre_process/m_initial_condition.fpp

@@ -18,20 +18,7 @@ module m_initial_condition
 
     implicit none
 
-    ! NOTE: Abstract interface enables dynamic dispatch without repeated model_eqns checks
-    type(scalar_field), allocatable, dimension(:)    :: q_prim_vf  !< primitive variables
-    type(scalar_field), allocatable, dimension(:)    :: q_cons_vf  !< conservative variables
-    type(scalar_field)                               :: q_T_sf     !< Temperature field
-    type(integer_field), dimension(:,:), allocatable :: bc_type    !< bc_type fields
-    !> @cond
-#ifdef MFC_MIXED_PRECISION
-    integer(kind=1), allocatable, dimension(:,:,:) :: patch_id_fp
-#else
-    !> @endcond
-    integer, allocatable, dimension(:,:,:) :: patch_id_fp
-    !> @cond
-#endif
-    !> @endcond
+    type(ic_context) :: ic  !< Initial-condition state (fields, bc types, patch ids)
 
 contains
 
@@ -40,82 +27,82 @@ contains
 
         integer :: i, j, k, l
 
-        allocate (q_prim_vf(1:sys_size))
-        allocate (q_cons_vf(1:sys_size))
+        allocate (ic%q_prim_vf(1:sys_size))
+        allocate (ic%q_cons_vf(1:sys_size))
 
         do i = 1, sys_size
-            allocate (q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end,idwbuff(2)%beg:idwbuff(2)%end,idwbuff(3)%beg:idwbuff(3)%end))
-            allocate (q_cons_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end,idwbuff(2)%beg:idwbuff(2)%end,idwbuff(3)%beg:idwbuff(3)%end))
+            allocate (ic%q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end,idwbuff(2)%beg:idwbuff(2)%end,idwbuff(3)%beg:idwbuff(3)%end))
+            allocate (ic%q_cons_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end,idwbuff(2)%beg:idwbuff(2)%end,idwbuff(3)%beg:idwbuff(3)%end))
         end do
 
         if (chemistry) then
-            allocate (q_T_sf%sf(idwbuff(1)%beg:idwbuff(1)%end,idwbuff(2)%beg:idwbuff(2)%end,idwbuff(3)%beg:idwbuff(3)%end))
+            allocate (ic%q_T_sf%sf(idwbuff(1)%beg:idwbuff(1)%end,idwbuff(2)%beg:idwbuff(2)%end,idwbuff(3)%beg:idwbuff(3)%end))
         end if
 
-        allocate (patch_id_fp(0:m,0:n,0:p))
+        allocate (ic%patch_id_fp(0:m,0:n,0:p))
 
         if (qbmm .and. .not. polytropic) then
             allocate (pb%sf(0:m,0:n,0:p,1:nnode,1:nb))
             allocate (mv%sf(0:m,0:n,0:p,1:nnode,1:nb))
         end if
 
         do i = 1, sys_size
-            q_cons_vf(i)%sf = -1.e-6_stp  ! real(dflt_real, kind=stp) ! TODO :: remove this magic number
-            q_prim_vf(i)%sf = -1.e-6_stp  ! real(dflt_real, kind=stp)
+            ic%q_cons_vf(i)%sf = -1.e-6_stp  ! real(dflt_real, kind=stp) ! TODO :: remove this magic number
+            ic%q_prim_vf(i)%sf = -1.e-6_stp  ! real(dflt_real, kind=stp)
         end do
 
-        allocate (bc_type(1:num_dims,1:2))
+        allocate (ic%bc_type(1:num_dims,1:2))
 
-        allocate (bc_type(1, 1)%sf(0:0,0:n,0:p))
-        allocate (bc_type(1, 2)%sf(0:0,0:n,0:p))
+        allocate (ic%bc_type(1, 1)%sf(0:0,0:n,0:p))
+        allocate (ic%bc_type(1, 2)%sf(0:0,0:n,0:p))
 
         do l = 0, p
             do k = 0, n
-                bc_type(1, 1)%sf(0, k, l) = int(min(bc_x%beg, 0), kind=1)
-                bc_type(1, 2)%sf(0, k, l) = int(min(bc_x%end, 0), kind=1)
+                ic%bc_type(1, 1)%sf(0, k, l) = int(min(bc_x%beg, 0), kind=1)
+                ic%bc_type(1, 2)%sf(0, k, l) = int(min(bc_x%end, 0), kind=1)
             end do
         end do
 
         if (n > 0) then
-            allocate (bc_type(2, 1)%sf(-buff_size:m + buff_size,0:0,0:p))
-            allocate (bc_type(2, 2)%sf(-buff_size:m + buff_size,0:0,0:p))
+            allocate (ic%bc_type(2, 1)%sf(-buff_size:m + buff_size,0:0,0:p))
+            allocate (ic%bc_type(2, 2)%sf(-buff_size:m + buff_size,0:0,0:p))
 
             do l = 0, p
                 do j = -buff_size, m + buff_size
-                    bc_type(2, 1)%sf(j, 0, l) = int(min(bc_y%beg, 0), kind=1)
-                    bc_type(2, 2)%sf(j, 0, l) = int(min(bc_y%end, 0), kind=1)
+                    ic%bc_type(2, 1)%sf(j, 0, l) = int(min(bc_y%beg, 0), kind=1)
+                    ic%bc_type(2, 2)%sf(j, 0, l) = int(min(bc_y%end, 0), kind=1)
                 end do
             end do
 
             if (p > 0) then
-                allocate (bc_type(3, 1)%sf(-buff_size:m + buff_size,-buff_size:n + buff_size,0:0))
-                allocate (bc_type(3, 2)%sf(-buff_size:m + buff_size,-buff_size:n + buff_size,0:0))
+                allocate (ic%bc_type(3, 1)%sf(-buff_size:m + buff_size,-buff_size:n + buff_size,0:0))
+                allocate (ic%bc_type(3, 2)%sf(-buff_size:m + buff_size,-buff_size:n + buff_size,0:0))
 
                 do k = -buff_size, n + buff_size
                     do j = -buff_size, m + buff_size
-                        bc_type(3, 1)%sf(j, k, 0) = int(min(bc_z%beg, 0), kind=1)
-                        bc_type(3, 2)%sf(j, k, 0) = int(min(bc_z%end, 0), kind=1)
+                        ic%bc_type(3, 1)%sf(j, k, 0) = int(min(bc_z%beg, 0), kind=1)
+                        ic%bc_type(3, 2)%sf(j, k, 0) = int(min(bc_z%end, 0), kind=1)
                     end do
                 end do
             end if
         end if
 
         ! Initial damage state is always zero
         if (cont_damage) then
-            q_cons_vf(eqn_idx%damage)%sf = 0._wp
-            q_prim_vf(eqn_idx%damage)%sf = 0._wp
+            ic%q_cons_vf(eqn_idx%damage)%sf = 0._wp
+            ic%q_prim_vf(eqn_idx%damage)%sf = 0._wp
         end if
 
         ! Initial hyper_cleaning state is always zero TODO more general
         if (hyper_cleaning) then
-            q_cons_vf(eqn_idx%psi)%sf = 0._wp
-            q_prim_vf(eqn_idx%psi)%sf = 0._wp
+            ic%q_cons_vf(eqn_idx%psi)%sf = 0._wp
+            ic%q_prim_vf(eqn_idx%psi)%sf = 0._wp
         end if
 
         ! Setting default values for patch identities bookkeeping variable. This is necessary to avoid any confusion in the
         ! assessment of the extent of application that the overwrite permissions give a patch when it is being applied in the
         ! domain.
-        patch_id_fp = 0
+        ic%patch_id_fp = 0
 
     end subroutine s_initialize_initial_condition_module
 
@@ -127,31 +114,31 @@ contains
         integer :: i
 
         if (old_ic) then
-            call s_convert_conservative_to_primitive_variables(q_cons_vf, q_T_sf, q_prim_vf, idwbuff)
+            call s_convert_conservative_to_primitive_variables(ic%q_cons_vf, ic%q_T_sf, ic%q_prim_vf, idwbuff)
         end if
 
-        call s_apply_icpp_patches(patch_id_fp, q_prim_vf)
+        call s_apply_icpp_patches(ic%patch_id_fp, ic%q_prim_vf)
 
-        if (num_bc_patches > 0) call s_apply_boundary_patches(q_prim_vf, bc_type)
+        if (num_bc_patches > 0) call s_apply_boundary_patches(ic%q_prim_vf, ic%bc_type)
 
-        if (perturb_flow) call s_perturb_surrounding_flow(q_prim_vf)
-        if (perturb_sph) call s_perturb_sphere(q_prim_vf)
-        if (mixlayer_perturb) call s_perturb_mixlayer(q_prim_vf)
-        if (simplex_perturb) call s_perturb_simplex(q_prim_vf)
-        if (chemistry) call s_compute_T_from_primitives(q_T_sf, q_prim_vf, idwint)
+        if (perturb_flow) call s_perturb_surrounding_flow(ic%q_prim_vf)
+        if (perturb_sph) call s_perturb_sphere(ic%q_prim_vf)
+        if (mixlayer_perturb) call s_perturb_mixlayer(ic%q_prim_vf)
+        if (simplex_perturb) call s_perturb_simplex(ic%q_prim_vf)
+        if (chemistry) call s_compute_T_from_primitives(ic%q_T_sf, ic%q_prim_vf, idwint)
 
         if (elliptic_smoothing .and. chemistry) then
-            call s_elliptic_smoothing(q_prim_vf, bc_type, q_T_sf)
-            call s_compute_T_from_primitives(q_T_sf, q_prim_vf, idwint)
+            call s_elliptic_smoothing(ic%q_prim_vf, ic%bc_type, ic%q_T_sf)
+            call s_compute_T_from_primitives(ic%q_T_sf, ic%q_prim_vf, idwint)
         else if (elliptic_smoothing) then
-            call s_elliptic_smoothing(q_prim_vf, bc_type)
+            call s_elliptic_smoothing(ic%q_prim_vf, ic%bc_type)
         end if
 
-        call s_convert_primitive_to_conservative_variables(q_prim_vf, q_cons_vf)
+        call s_convert_primitive_to_conservative_variables(ic%q_prim_vf, ic%q_cons_vf)
 
         if (qbmm .and. .not. polytropic) then
-            call s_initialize_mv(q_cons_vf, mv%sf)
-            call s_initialize_pb(q_cons_vf, mv%sf, pb%sf)
+            call s_initialize_mv(ic%q_cons_vf, mv%sf)
+            call s_initialize_pb(ic%q_cons_vf, mv%sf, pb%sf)
         end if
 
     end subroutine s_generate_initial_condition
@@ -162,33 +149,33 @@ contains
         integer :: i
 
         do i = 1, sys_size
-            deallocate (q_prim_vf(i)%sf)
-            deallocate (q_cons_vf(i)%sf)
+            deallocate (ic%q_prim_vf(i)%sf)
+            deallocate (ic%q_cons_vf(i)%sf)
         end do
 
-        deallocate (q_prim_vf)
-        deallocate (q_cons_vf)
+        deallocate (ic%q_prim_vf)
+        deallocate (ic%q_cons_vf)
 
         if (chemistry) then
-            deallocate (q_T_sf%sf)
+            deallocate (ic%q_T_sf%sf)
         end if
 
-        deallocate (patch_id_fp)
+        deallocate (ic%patch_id_fp)
 
-        deallocate (bc_type(1, 1)%sf)
-        deallocate (bc_type(1, 2)%sf)
+        deallocate (ic%bc_type(1, 1)%sf)
+        deallocate (ic%bc_type(1, 2)%sf)
 
         if (n > 0) then
-            deallocate (bc_type(2, 1)%sf)
-            deallocate (bc_type(2, 2)%sf)
+            deallocate (ic%bc_type(2, 1)%sf)
+            deallocate (ic%bc_type(2, 2)%sf)
         end if
 
         if (p > 0) then
-            deallocate (bc_type(3, 1)%sf)
-            deallocate (bc_type(3, 2)%sf)
+            deallocate (ic%bc_type(3, 1)%sf)
+            deallocate (ic%bc_type(3, 2)%sf)
         end if
 
-        deallocate (bc_type)
+        deallocate (ic%bc_type)
 
     end subroutine s_finalize_initial_condition_module
 

src/pre_process/m_start_up.fpp

@@ -531,7 +531,7 @@ contains
 
         call cpu_time(start)
 
-        if (old_ic) call s_read_ic_data_files(q_cons_vf)
+        if (old_ic) call s_read_ic_data_files(ic%q_cons_vf)
 
         call s_generate_initial_condition()
 
@@ -544,8 +544,8 @@ contains
                         r2 = x_cc(j)**2
                         if (n > 0) r2 = r2 + y_cc(k)**2
                         if (p > 0) r2 = r2 + z_cc(l)**2
-                        q_cons_vf(eqn_idx%psi)%sf(j, k, l) = 1.0e-2_wp*exp(-r2/(2.0_wp*0.05_wp**2))
-                        q_prim_vf(eqn_idx%psi)%sf(j, k, l) = q_cons_vf(eqn_idx%psi)%sf(j, k, l)
+                        ic%q_cons_vf(eqn_idx%psi)%sf(j, k, l) = 1.0e-2_wp*exp(-r2/(2.0_wp*0.05_wp**2))
+                        ic%q_prim_vf(eqn_idx%psi)%sf(j, k, l) = ic%q_cons_vf(eqn_idx%psi)%sf(j, k, l)
                     end do
                 end do
             end do
@@ -556,13 +556,13 @@ contains
                 print *, 'initial condition might have been altered due to enforcement of pTg-equilibrium (relax = "T" activated)'
             end if
 
-            call s_infinite_relaxation_k(q_cons_vf)
+            call s_infinite_relaxation_k(ic%q_cons_vf)
         end if
 
         if (chemistry) then
-            call s_write_data_files(q_cons_vf, q_prim_vf, bc_type, q_T_sf)
+            call s_write_data_files(ic%q_cons_vf, ic%q_prim_vf, ic%bc_type, ic%q_T_sf)
         else
-            call s_write_data_files(q_cons_vf, q_prim_vf, bc_type)
+            call s_write_data_files(ic%q_cons_vf, ic%q_prim_vf, ic%bc_type)
         end if
 
         call cpu_time(finish)