Hide some MPI directives behind PARSOLVER statement.

Sources/bmw_run.f

@@ -56,6 +56,7 @@ SUBROUTINE bmw_exec(mgrid_file_name, wout_file_name,                     &
      &                    r_grid, z_grid, dphi, A_r, A_p, A_z)
       USE read_wout_mod, ONLY: nfp_vmec=>nfp
       USE island_params, ONLY: nfp_i
+      USE descriptor_mod, ONLY: SIESTA_COMM
 
 !  Declare Arguments
       CHARACTER (len=*), INTENT(in)                 :: mgrid_file_name
@@ -80,7 +81,7 @@ SUBROUTINE bmw_exec(mgrid_file_name, wout_file_name,                     &
 !  Start of executable code
       CALL profiler_construct
 
-      parallel => bmw_parallel_context_class(MPI_COMM_WORLD)
+      parallel => bmw_parallel_context_class(SIESTA_COMM)
       flags = bmw_state_flags_off
 
       CALL parallel%set_threads(-1)

Sources/diagnostics_mod.f90

@@ -100,12 +100,14 @@ SUBROUTINE divb(ns_min, ns_max)
 
       divb_rms = SUM(divbmnsf(:,:,nl:nh)**2 + divbmncf(:,:,nl:nh)**2)
 #if defined(MPI_OPT)
-      temp(1) = divb_rms
-      temp(2) = tnorm
-      CALL MPI_ALLREDUCE(MPI_IN_PLACE,temp,2,MPI_REAL8, MPI_SUM,               &
-                         SIESTA_COMM,MPI_ERR)
-      divb_rms = temp(1)
-      tnorm = temp(2)
+      IF (PARSOLVER) THEN
+         temp(1) = divb_rms
+         temp(2) = tnorm
+         CALL MPI_ALLREDUCE(MPI_IN_PLACE,temp,2,MPI_REAL8, MPI_SUM,            &
+                            SIESTA_COMM,MPI_ERR)
+         divb_rms = temp(1)
+         tnorm = temp(2)
+      END IF
 #endif
       IF (tnorm .NE. zero) THEN
          divb_rms = SQRT(divb_rms/tnorm)
@@ -526,12 +528,12 @@ SUBROUTINE get_bgradp(ns_min, ns_max)
       wbgradp = SUM(bgradpf(:,:,n1:n2)**2*wint(:,:,n1:n2))
       temp(1) = tnorm_bgradp
       temp(2) = wbgradp
-      IF (PARSOLVER) THEN
 #if defined(MPI_OPT)
+      IF (PARSOLVER) THEN
          CALL MPI_ALLREDUCE(MPI_IN_PLACE, temp, 2, MPI_REAL8, MPI_SUM,         &
                             SIESTA_COMM, MPI_ERR)
-#endif
       END IF
+#endif
       tnorm_bgradp = temp(1)
       wbgradp = temp(2)
 
@@ -544,12 +546,12 @@ SUBROUTINE get_bgradp(ns_min, ns_max)
          min_bgradp = MINVAL(bgradpf(:,:,n1:n2))/tnorm_bgradp
          temp(1) = max_bgradp
          temp(2) = -min_bgradp
-         IF (PARSOLVER) THEN
 #if defined(MPI_OPT)
+         IF (PARSOLVER) THEN
             CALL MPI_ALLREDUCE(MPI_IN_PLACE, temp, 2, MPI_REAL8, MPI_MAX,      &
                                SIESTA_COMM, MPI_ERR)
-#endif
          END IF
+#endif
          max_bgradp = temp(1)
          min_bgradp = -temp(2)
          IF (.not.lasym) THEN
@@ -588,14 +590,12 @@ SUBROUTINE TFLUX
 
 !Averages over all toroidal cross sections (which should be the same)
       toroidal_flux = SUM(jbsupvmnch(m0,n0,nsmin:nsmax))
-      IF (PARSOLVER) THEN
 #if defined(MPI_OPT)
-      CALL MPI_ALLREDUCE(MPI_IN_PLACE,toroidal_flux,1,MPI_REAL8, MPI_SUM,   &
-                         SIESTA_COMM,MPI_ERR)
-#endif      
-!      ELSE
-!      toroidal_flux = part_sum      
+      IF (PARSOLVER) THEN
+         CALL MPI_ALLREDUCE(MPI_IN_PLACE,toroidal_flux,1,MPI_REAL8, MPI_SUM,   &
+                            SIESTA_COMM,MPI_ERR)
       END IF
+#endif
       toroidal_flux = signjac*twopi*toroidal_flux*hs_i/b_factor  
 
       IF (toroidal_flux0 .EQ. zero) toroidal_flux0 = toroidal_flux
@@ -1054,12 +1054,14 @@ SUBROUTINE divj(ns_min, ns_max)
       divj_rms = SUM(divjmnsh(:,:,n1:n2)**2                                    &
                +     divjmnch(:,:,n1:n2)**2)
 #if defined(MPI_OPT)
-      temp(1) = divj_rms
-      temp(2) = tnorm
-      CALL MPI_ALLREDUCE(MPI_IN_PLACE,temp,2,MPI_REAL8, MPI_SUM,               &
-                         SIESTA_COMM,MPI_ERR)
-      divj_rms = temp(1)
-      tnorm = temp(2)
+      IF (PARSOLVER) THEN
+         temp(1) = divj_rms
+         temp(2) = tnorm
+         CALL MPI_ALLREDUCE(MPI_IN_PLACE,temp,2,MPI_REAL8, MPI_SUM,            &
+                            SIESTA_COMM,MPI_ERR)
+         divj_rms = temp(1)
+         tnorm = temp(2)
+      END IF
 #endif
 
 !  Compute rms of divergence of J

Sources/dumping_mod.f90

@@ -812,23 +812,23 @@ SUBROUTINE prepare_quantities
            CALL fourier_context%tomnsp(ksubvijf, ksubvmncf, f_cos)
 
            IF (lasym) THEN
-           ksupsmncf = ksupsmncf/b_factor
-           ksupumnsf = ksupumnsf/b_factor
-           ksupvmnsf = ksupvmnsf/b_factor
-
-           ALLOCATE(bsubsmnch(0:mpol,-ntor:ntor,ns),                    &
-                    bsubumnsh(0:mpol,-ntor:ntor,ns),                    &
-                    bsubvmnsh(0:mpol,-ntor:ntor,ns),                    &
-                    ksubsmncf(0:mpol,-ntor:ntor,ns),                    &
-                    ksubumnsf(0:mpol,-ntor:ntor,ns),                    &
-                    ksubvmnsf(0:mpol,-ntor:ntor,ns), stat=istat)
-           CALL ASSERT(istat.eq.0,'Allocation failed in DUMPING PREPARE_QUANTITIES')
-           CALL fourier_context%tomnsp(bsubsijh, bsubsmnch, f_cos)                       ! compute harmonics
-           CALL fourier_context%tomnsp(bsubuijh, bsubumnsh, f_sin)
-           CALL fourier_context%tomnsp(bsubvijh, bsubvmnsh, f_sin)
-           CALL fourier_context%tomnsp(ksubsijf, ksubsmncf, f_cos)
-           CALL fourier_context%tomnsp(ksubuijf, ksubumnsf, f_sin)
-           CALL fourier_context%tomnsp(ksubvijf, ksubvmnsf, f_sin)
+              ksupsmncf = ksupsmncf/b_factor
+              ksupumnsf = ksupumnsf/b_factor
+              ksupvmnsf = ksupvmnsf/b_factor
+
+              ALLOCATE(bsubsmnch(0:mpol,-ntor:ntor,ns),                    &
+                       bsubumnsh(0:mpol,-ntor:ntor,ns),                    &
+                       bsubvmnsh(0:mpol,-ntor:ntor,ns),                    &
+                       ksubsmncf(0:mpol,-ntor:ntor,ns),                    &
+                       ksubumnsf(0:mpol,-ntor:ntor,ns),                    &
+                       ksubvmnsf(0:mpol,-ntor:ntor,ns), stat=istat)
+              CALL ASSERT(istat.eq.0,'Allocation failed in DUMPING PREPARE_QUANTITIES')
+              CALL fourier_context%tomnsp(bsubsijh, bsubsmnch, f_cos)                       ! compute harmonics
+              CALL fourier_context%tomnsp(bsubuijh, bsubumnsh, f_sin)
+              CALL fourier_context%tomnsp(bsubvijh, bsubvmnsh, f_sin)
+              CALL fourier_context%tomnsp(ksubsijf, ksubsmncf, f_cos)
+              CALL fourier_context%tomnsp(ksubuijf, ksubumnsf, f_sin)
+              CALL fourier_context%tomnsp(ksubvijf, ksubvmnsf, f_sin)
            END IF
 
            DEALLOCATE (bsubsijh, bsubuijh, bsubvijh)

Sources/siesta_currents.f90

@@ -143,13 +143,13 @@ SUBROUTINE cv_currents(bsupsijh, bsupuijh, bsupvijh,                     &
 
          wb = SUM(bsq(:,:,nmin:nmax)*jacobh(:,:,nmin:nmax)*wint(:,:,nmin:nmax))
 
-         IF (PARSOLVER) THEN
 #if defined(MPI_OPT)
+         IF (PARSOLVER) THEN
 !  FIXME: All reduce is not deterministic. This causes a divergent run sequence.
             CALL MPI_ALLREDUCE(MPI_IN_PLACE, wb, 1, MPI_REAL8, MPI_SUM,        &
                                SIESTA_COMM, MPI_ERR)
-#endif
          END IF
+#endif
          wb = signjac*(twopi*pi*hs_i)*wb
       END IF
 

Sources/siesta_force.f90

@@ -694,8 +694,10 @@ SUBROUTINE get_force_harmonics(pardamp, f_smnf, f_umnf, f_vmnf, parity)
          END IF
 
 #if defined(MPI_OPT)
-         CALL MPI_ALLREDUCE(MPI_IN_PLACE, tmps, 10, MPI_REAL8, MPI_SUM,        &
-                            SIESTA_COMM, MPI_ERR)
+         IF (PARSOLVER) THEN
+            CALL MPI_ALLREDUCE(MPI_IN_PLACE, tmps, 10, MPI_REAL8, MPI_SUM,     &
+                               SIESTA_COMM, MPI_ERR)
+         END IF
 #endif
 
          IF (iam .eq. 0 .and. lverbose) THEN