Split array for reference evaluation

Author: hiromatsui

src/Fortran_libraries/MHD_src/sph_MHD/const_diffusive_profile.f90

@@ -24,9 +24,10 @@
 !!        type(fdm2_center_mat), intent(in) :: fdm2_center
 !!        type(phys_data), intent(in) :: rj_fld
 !!        type(band_matrix_type), intent(in) :: band_s00_poisson
-!!      subroutine cal_reference_source(sph_rj, band_s00_poisson,       &
-!!     &                                ref_source, ref_local)
+!!      subroutine cal_reference_source(sph_rj, sc_prop,                &
+!!     &          band_s00_poisson, ref_source, ref_local)
 !!        type(sph_rj_grid), intent(in) :: sph_rj
+!!        type(scalar_property), intent(in) :: sc_prop
 !!        type(band_matrix_type), intent(in) :: band_s00_poisson
 !!        real(kind = kreal), intent(in)                                &
 !!     &                :: ref_source(0:sph_rj%nidx_rj(1))
@@ -66,7 +67,7 @@ module const_diffusive_profile
 !
       subroutine s_const_diffusive_profile(sph_rj, r_2nd,               &
      &          sc_prop, sph_bc, bcs_S, fdm2_center, band_s00_poisson,  &
-     &          reftemp_r, refgrad_r, ref_local)
+     &          reftemp_r, refgrad_r, ref_local, grad_local)
 !
       use calypso_mpi
       use calypso_mpi_real
@@ -87,48 +88,48 @@ subroutine s_const_diffusive_profile(sph_rj, r_2nd,               &
       real(kind=kreal), intent(inout) :: reftemp_r(0:sph_rj%nidx_rj(1))
       real(kind=kreal), intent(inout) :: refgrad_r(0:sph_rj%nidx_rj(1))
       real(kind = kreal), intent(inout)                                 &
-     &                :: ref_local(0:sph_rj%nidx_rj(1),0:1)
+     &                :: ref_local(0:sph_rj%nidx_rj(1))
+      real(kind = kreal), intent(inout)                                 &
+     &                :: grad_local(0:sph_rj%nidx_rj(1))
 !
       integer(kind = kint_gl) :: num64
 !      integer :: k
 !
       if(sph_rj%idx_rj_degree_zero .gt. 0) then
 !$omp parallel workshare
-        ref_local(0:sph_rj%nidx_rj(1),0)                                &
-     &             = ref_local(0:sph_rj%nidx_rj(1),0)                   &
-     &              * (sc_prop%coef_source / sc_prop%coef_diffuse)
+        ref_local(0:sph_rj%nidx_rj(1)) = ref_local(0:sph_rj%nidx_rj(1)) &
+     &                   * (sc_prop%coef_source / sc_prop%coef_diffuse)
 !$omp end parallel workshare
 !
         call set_ICB_scalar_boundary_1d                                 &
-     &     (sph_rj, sph_bc, bcs_S%ICB_Sspec, ref_local(0,0))
+     &     (sph_rj, sph_bc, bcs_S%ICB_Sspec, ref_local(0))
         call set_CMB_scalar_boundary_1d                                 &
-     &     (sph_rj, sph_bc, bcs_S%CMB_Sspec, ref_local(0,0))
+     &     (sph_rj, sph_bc, bcs_S%CMB_Sspec, ref_local(0))
 !
 !        do k = 0, sph_rj%nidx_rj(1)
-!          write(*,*) k, 'RHS', ref_local(k,0)
+!          write(*,*) k, 'RHS', ref_local(k)
 !        end do
 !
-        call lubksb_3band_ctr(band_s00_poisson, ref_local(0,0))
+        call lubksb_3band_ctr(band_s00_poisson, ref_local(0))
 !        call s_cal_sol_reftemp_BiCGSTAB                                &
-!     &     (band_s00_poisson, ref_local(0,0))
+!     &     (band_s00_poisson, ref_local(0))
 !
 !        do k = 0, sph_rj%nidx_rj(1)
-!          write(*,*) k, 'Solution', ref_local(k,0)
+!          write(*,*) k, 'Solution', ref_local(k)
 !        end do
 !
         call fill_scalar_1d_external(sph_bc, sph_rj%inod_rj_center,     &
-     &                               sph_rj%nidx_rj(1), ref_local(0,0))
+     &                               sph_rj%nidx_rj(1), ref_local(0))
 !
         call cal_sph_nod_gradient_1d(sph_bc%kr_in, sph_bc%kr_out,       &
      &                            sph_rj%nidx_rj(1), r_2nd%fdm(1)%dmat, &
-     &                            ref_local(0,0), ref_local(0,1))
+     &                            ref_local(0), grad_local(0))
 !
         call sel_ICB_radial_grad_1d_scalar                              &
      &     (sph_rj, sph_bc, bcs_S%ICB_Sspec, fdm2_center,               &
-     &      ref_local(0,0), ref_local(0,1))
+     &      ref_local, grad_local)
         call sel_CMB_radial_grad_1d_scalar                              &
-     &     (sph_rj, sph_bc, bcs_S%CMB_Sspec,                            &
-     &      ref_local(0,0), ref_local(0,1))
+     &     (sph_rj, sph_bc, bcs_S%CMB_Sspec, ref_local, grad_local)
       end if
 !
 !$omp parallel workshare
@@ -137,9 +138,9 @@ subroutine s_const_diffusive_profile(sph_rj, r_2nd,               &
 !$omp end parallel workshare
 !
       num64 = sph_rj%nidx_rj(1) + 1
-      call calypso_mpi_allreduce_real(ref_local(0,0), reftemp_r,        &
+      call calypso_mpi_allreduce_real(ref_local(0), reftemp_r,          &
      &                                num64, MPI_SUM)
-      call calypso_mpi_allreduce_real(ref_local(0,1), refgrad_r,        &
+      call calypso_mpi_allreduce_real(grad_local(0), refgrad_r,         &
      &                                num64, MPI_SUM)
 !
       end subroutine s_const_diffusive_profile
@@ -243,7 +244,7 @@ subroutine gradient_of_radial_reference(sph_rj, r_2nd,            &
       real(kind=kreal), intent(inout) :: refgrad_r(0:sph_rj%nidx_rj(1))
 !
 !
-      call fill_scalar_1d_external(sph_bc, sph_rj%inod_rj_center,     &
+      call fill_scalar_1d_external(sph_bc, sph_rj%inod_rj_center,       &
      &                             sph_rj%nidx_rj(1), reftemp_r(0))
 !
       call cal_sph_nod_gradient_1d(sph_bc%kr_in, sph_bc%kr_out,         &
@@ -260,10 +261,11 @@ end subroutine gradient_of_radial_reference
 !
 ! -----------------------------------------------------------------------
 !
-      subroutine cal_reference_source(sph_rj, band_s00_poisson,         &
-     &                                ref_source, ref_local)
+      subroutine cal_reference_source(sph_rj, sc_prop,                  &
+     &          band_s00_poisson, ref_source, ref_local)
 !
       type(sph_rj_grid), intent(in) :: sph_rj
+      type(scalar_property), intent(in) :: sc_prop
       type(band_matrix_type), intent(in) :: band_s00_poisson
 !
       real(kind = kreal), intent(in)                                    &
@@ -288,6 +290,11 @@ subroutine cal_reference_source(sph_rj, band_s00_poisson,         &
       k = sph_rj%nidx_rj(1)
       ref_local(k) =  band_s00_poisson%mat(3,k-1) * ref_source(k-1)     &
      &              + band_s00_poisson%mat(2,k  ) * ref_source(k)
+!
+!$omp parallel workshare
+      ref_local(0:sph_rj%nidx_rj(1)) = ref_local(0:sph_rj%nidx_rj(1))   &
+     &                   * (sc_prop%coef_diffuse / sc_prop%coef_source)
+!$omp end parallel workshare
 !
       end subroutine cal_reference_source
 !

src/Fortran_libraries/MHD_src/sph_MHD/const_radial_references.f90

@@ -104,7 +104,7 @@ subroutine const_diffusive_profiles(sph_rj, sc_prop,              &
       call s_const_diffusive_profile(sph_rj, r_2nd, sc_prop,            &
      &    sph_bc_S, bcs_S, fdm2_center, band_s00_poisson,               &
      &    ref_field%d_fld(1,iref_scalar), ref_field%d_fld(1,iref_grad), &
-     &    ref_local)
+     &    ref_local(0,0), ref_local(0,1))
       deallocate(ref_local)
 !
       end subroutine const_diffusive_profiles
@@ -177,16 +177,8 @@ subroutine const_reference_source(sph_rj, sc_prop,                &
 !
       if(iref_source*iref_scalar .le. 0) return
       if(sph_rj%idx_rj_degree_zero .gt. 0) then
-        if(iref_source .gt. 0) then
-          call cal_reference_source(sph_rj, band_s00_poisson,           &
-     &        ref_field%d_fld(1,iref_scalar), ref_local)
-!
-!$omp parallel workshare
-          ref_local(0:sph_rj%nidx_rj(1))                                &
-     &                  = ref_local(0:sph_rj%nidx_rj(1))                &
-     &                   * (sc_prop%coef_diffuse / sc_prop%coef_source)
-!$omp end parallel workshare
-        end if
+        call cal_reference_source(sph_rj, sc_prop, band_s00_poisson,    &
+     &      ref_field%d_fld(1,iref_scalar), ref_local)
       end if
 !
       num64 = sph_rj%nidx_rj(1) + 1