diff --git a/CPV/cplib.f90 b/CPV/cplib.f90 index bd9c7b049..488430d30 100644 --- a/CPV/cplib.f90 +++ b/CPV/cplib.f90 @@ -2251,7 +2251,7 @@ #ifdef __PARA call cfft_cp(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,-1,dfftp) #else -# if defined __AIX || __FFTW +# if defined __AIX || __FFTW || __SGI call cfft3d(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,-1) # else call cfft3(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,-1) @@ -2275,7 +2275,7 @@ #ifdef __PARA call cfft_cp(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,-1,dffts) #else -# if defined __AIX || __FFTW +# if defined __AIX || __FFTW || __SGI call cfft3d(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,-1) # else call cfft3s(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,-1) @@ -2299,7 +2299,7 @@ #ifdef __PARA call cfft_cp(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,-2,dffts) #else -# if defined __AIX || __FFTW +# if defined __AIX || __FFTW || __SGI call cfft3d(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,-1) # else call cfft3s(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,-1) @@ -3788,7 +3788,7 @@ #ifdef __PARA call cfft_cp(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,1,dfftp) #else -# if defined __AIX || __FFTW +# if defined __AIX || __FFTW || __SGI call cfft3d(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,1) # else call cfft3(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,1) @@ -3811,7 +3811,7 @@ #ifdef __PARA call cfftpb(f,nr1b,nr2b,nr3b,nr1bx,nr2bx,nr3bx,irb3,1) #else -# if defined __AIX || __FFTW +# if defined __AIX || __FFTW || __SGI call cfft3d(f,nr1b,nr2b,nr3b,nr1bx,nr2bx,nr3bx,1) # else call cfft3b(f,nr1b,nr2b,nr3b,nr1bx,nr2bx,nr3bx,1) @@ -3836,7 +3836,7 @@ #ifdef __PARA call cfft_cp(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,1,dffts) #else -# if defined __AIX || __FFTW +# if defined __AIX || __FFTW || __SGI call cfft3d(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,1) # else call cfft3s(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,1) @@ -3861,7 +3861,7 @@ #ifdef __PARA call cfft_cp(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,2,dffts) #else -# if defined __AIX || __FFTW +# if defined __AIX || __FFTW || __SGI call cfft3d(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,1) # else call cfft3s(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,1) diff --git a/CPV/macdep.f90 b/CPV/macdep.f90 index 26516c6c7..68ee78ef4 100644 --- a/CPV/macdep.f90 +++ b/CPV/macdep.f90 @@ -293,6 +293,7 @@ good=.false. else ! specific (machine- and library-dependent cases) + #ifdef __AIX ! ! IBM machines with essl libraries @@ -304,9 +305,10 @@ & pwr(5).le.1 .and. & & ((pwr(2).eq.0 .and. pwr(3)+pwr(4)+pwr(5).le.2) .or. & & (pwr(2).ne.0 .and. pwr(3)+pwr(4)+pwr(5).le.1) ) + #endif ! -#if defined(__CRAYY) || defined(__SX4) +#if defined(__CRAYY) || defined(__SX4) || defined(__SGI) || defined(__ORIGIN) ! ! Cray and t3d machines with scilib libraries ! diff --git a/Modules/clocks.f90 b/Modules/clocks.f90 index 52d64dfee..3c326ed76 100644 --- a/Modules/clocks.f90 +++ b/Modules/clocks.f90 @@ -155,6 +155,8 @@ subroutine print_this_clock (n) ! use parameters use mytime + use mp, only: mp_max, mp_min + use mp_global, only: group, inter_pool_comm implicit none real(kind=8) :: scnds @@ -185,9 +187,8 @@ subroutine print_this_clock (n) ! /* #define DEBUG */ ! #ifndef DEBUG - call extreme (elapsed_cpu_time, + 1) - - call poolextreme (elapsed_cpu_time, + 1) + call mp_max( elapsed_cpu_time, group ) + call mp_max( elapsed_cpu_time, inter_pool_comm ) #endif #endif if (n.eq.1) then @@ -227,6 +228,8 @@ real(kind=8) function get_clock (label) ! use parameters use mytime + use mp, only: mp_max, mp_min + use mp_global, only: group, inter_pool_comm implicit none @@ -253,8 +256,8 @@ real(kind=8) function get_clock (label) ! ! In the parallel case, use the maximum over all nodes and pools ! - call extreme (get_clock, + 1) - call poolextreme (get_clock, + 1) + call mp_max( get_clock, group ) + call mp_max( get_clock, inter_pool_comm ) #endif return endif diff --git a/Modules/fft_scalar.f90 b/Modules/fft_scalar.f90 index f25864b5a..01c1a3a58 100644 --- a/Modules/fft_scalar.f90 +++ b/Modules/fft_scalar.f90 @@ -80,7 +80,7 @@ REAL (dbl) :: bw_tablex(ltabl,ndims) REAL (dbl) :: bw_tabley(ltabl,ndims) -#else +#elif defined __SGI || defined __T3E REAL (dbl) :: work(lwork) REAL (dbl) :: tablez(ltabl,ndims) @@ -245,7 +245,7 @@ #elif defined __SGI IF (isign /= 0) THEN - CALL zfftm1d( isign, nz, nsl, c(1,1), 1, ldc, tablez(i,ip) ) + CALL zfftm1d( isign, nz, nsl, c(1,1), 1, ldc, tablez(1,ip) ) IF (isign > 0) THEN CALL zdscal(SIZE(c), scale, c(1,1), 1) END IF @@ -420,7 +420,7 @@ IF( isign /= 0 ) THEN do i = 1, nxl IF( pl2ix( i ) > 0 ) THEN - call zfftm1d( isign, ny, nzl, r(i,1,1), ldx, ldx*ldy, tabley(ip) ) + call zfftm1d( isign, ny, nzl, r(i,1,1), ldx, ldx*ldy, tabley(1,ip) ) END IF end do END IF @@ -783,7 +783,9 @@ #elif defined __SGI IF (isign /= 0) THEN - CALL zfftm1d( isign, nz, nsl, c(1), 1, ldc, tablez(i,ip) ) + IF( isign < 0 ) idir = +1 + IF( isign > 0 ) idir = -1 + CALL zfftm1d( idir, nz, nsl, c(1), 1, ldc, tablez(1,ip) ) IF (isign > 0) THEN tscale = 1.0d0 / nz CALL zdscal(SIZE(c), tscale, c(1), 1) @@ -1073,34 +1075,28 @@ #elif defined __SGI IF( isign > 0 ) THEN + idir = -1 DO i = 1, nzl k = 1 + ( i - 1 ) * ldx * ldy - call zfftm1d( isign, nx, ny, r(k), 1, ldx, tablex(1,ip) ) + call zfftm1d( idir, nx, ny, r(k), 1, ldx, tablex(1,ip) ) END DO do i = 1, nx - dofft = .TRUE. - IF( PRESENT( pl2ix ) ) THEN - IF( pl2ix( i ) < 1 ) dofft = .FALSE. - END IF - IF( dofft ) THEN - call zfftm1d( isign, ny, nzl, r(i), ldx, ldx*ldy, tabley(1, ip) ) + IF( dofft( i ) ) THEN + call zfftm1d( idir, ny, nzl, r(i), ldx, ldx*ldy, tabley(1, ip) ) END IF end do tscale = 1.0d0 / ( nx * ny ) CALL zdscal(SIZE(r), tscale, r(1), 1) ELSE IF( isign < 0 ) THEN + idir = 1 do i = 1, nx - dofft = .TRUE. - IF( PRESENT( pl2ix ) ) THEN - IF( pl2ix( i ) < 1 ) dofft = .FALSE. - END IF - IF( dofft ) THEN - call zfftm1d( isign, ny, nzl, r(i), ldx, ldx*ldy, tabley(1, ip) ) + IF( dofft( i ) ) THEN + call zfftm1d( idir, ny, nzl, r(i), ldx, ldx*ldy, tabley(1, ip) ) END IF end do - DO i = 1, nzl + DO i = 1, nzl k = 1 + ( i - 1 ) * ldx * ldy - call zfftm1d( isign, nx, ny, r(k), 1, ldx, tablex(1,ip) ) + call zfftm1d( idir, nx, ny, r(k), 1, ldx, tablex(1,ip) ) END DO END IF @@ -1143,6 +1139,10 @@ #elif defined __AIX +#elif defined __SGI + + real(kind=8), save :: table( 3 * ltabl, ndims ) + #endif @@ -1181,6 +1181,10 @@ #elif defined __AIX +#elif defined __SGI + + CALL zfft3di( nr1, nr2, nr3, table(1,icurrent) ) + #endif dims(1,icurrent) = nr1; dims(2,icurrent) = nr2; dims(3,icurrent) = nr3 @@ -1218,6 +1222,17 @@ call dcft3( f(1), nr1x, nr1x*nr2x, f(1), nr1x, nr1x*nr2x, nr1, nr2, nr3, & isign, tscale, work(1), lwork) + +#elif defined __SGI + + IF( isign > 0 ) idir = -1 + IF( isign < 0 ) idir = +1 + IF( isign /= 0 ) & + CALL zfft3d( idir, nr1, nr2, nr3, f(1), nr1x, nr2x, table(1,ip) ) + IF( isign > 0 ) THEN + tscale = 1.0d0 / DBLE( nr1 * nr2 * nr3 ) + call ZDSCAL( nr1x * nr2x * nr3x, tscale, f(1), 1) + END IF #endif @@ -1264,6 +1279,12 @@ real(kind=8), save :: aux2( ltabl, ndims ) real(kind=8), save :: aux1( ltabl, ndims ) +#elif defined __SGI + + real(kind=8), save :: bw_coeffz( ltabl, ndims ) + real(kind=8), save :: bw_coeffy( ltabl, ndims ) + real(kind=8), save :: bw_coeffx( ltabl, ndims ) + #endif @@ -1324,6 +1345,12 @@ & tscale, aux2(1,icurrent), ltabl, work(1), lwork) end if +#elif defined __SGI + + call zfft1di( n3, bw_coeffz( 1, icurrent ) ) + call zfft1di( n2, bw_coeffy( 1, icurrent ) ) + call zfft1di( n1, bw_coeffx( 1, icurrent ) ) + #endif dims(1,icurrent) = n1; dims(2,icurrent) = n2 @@ -1360,6 +1387,15 @@ & tscale, aux2(1,ip), ltabl, work(1), lwork) END DO +#elif defined __SGI + + call zfftm1d( 1, n3, n1x*n2x, f(1), n1x*n2x, 1, bw_coeffz(1, ip) ) + call zfftm1d( 1, n1, n2x*nplanes, f(nstart), 1, n1x, bw_coeffx(1, ip) ) + DO K = imin3, imax3 + nstart = ( k - 1 ) * n1x * n2x + 1 + call zfftm1d( 1, n2, n1x, f(nstart), n1x, 1, bw_coeffy(1, ip) ) + END DO + #endif RETURN