From 69675454cc7db4b4c10b4c0cb80536c2049d0429 Mon Sep 17 00:00:00 2001 From: Alex Richert Date: Tue, 12 Mar 2024 09:55:44 -0700 Subject: [PATCH] Fix build warnings (#233) * Remove illegal tab characters * remove gcc10+ cmake block * remove arithmetic if's from fftpack.F * remove unused vars from spectral_interp_mod.F90 * fix real comparison in splegend.f * fix real comparison in spsynth.f * fix type conversion warnings in fftpack.F * remove unused var from sptrunmv.f * remove unused var from sptgpmv.f * remove unused var from sptgpm.f * remove unused var from splat.F * fix ncpus.F warnings * fix init warning in spsynth.f * remove unused/uninit'd vars from spffte.f * fix type inconsistencies in splat.F * remove unused var in test_splaplac.F90 * fix type inconsistencies in splegend.f * remove unused args/invalid boz ignore flags from tests/CMakeLists.txt * make afft allocatable in test_fft.F90 * fix types in tests * delete stray comment from test_fft.F90 --- CMakeLists.txt | 3 -- src/fftpack.F | 56 +++++++++++++++++++++++++++++-------- src/ncpus.F | 7 +++-- src/spectral_interp_mod.F90 | 4 +-- src/spffte.f | 23 ++++++--------- src/splat.F | 6 ++-- src/splegend.f | 17 +++++++---- src/spsynth.f | 3 +- src/sptez.f | 2 +- src/sptgpm.f | 1 - src/sptgpmv.f | 1 - src/sptranf.f | 4 +-- src/sptranfv.f | 4 +-- src/sptrunmv.f | 1 - tests/CMakeLists.txt | 5 ---- tests/test_fft.F90 | 9 +++--- tests/test_splaplac.F90 | 2 +- tests/test_splat.F90 | 10 +++---- tests/test_sptezv.F90 | 2 +- 19 files changed, 92 insertions(+), 68 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 76a38335..52d19cdc 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -66,9 +66,6 @@ elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -ggdb -Wall -Wno-unused-dummy-argument -Wsurprising -Wextra -fcheck=all") set(fortran_d_flags "-fdefault-real-8") set(fortran_8_flags "-fdefault-integer-8 -fdefault-real-8") - if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 10) - set(CMAKE_Fortran_FLAGS "-w ${CMAKE_Fortran_FLAGS}") - endif() endif() # This is the source code directiroy. diff --git a/src/fftpack.F b/src/fftpack.F index 1b3b14dd..5caaa752 100644 --- a/src/fftpack.F +++ b/src/fftpack.F @@ -332,12 +332,12 @@ SUBROUTINE RFFTI (N,WSAVE) C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO SUBROUTINE RFFTB1 (N,C,CH,WA,IFAC) REAL CH(*) ,C(*) ,WA(*) ,IFAC(*) - NF = IFAC(2) + NF = INT(IFAC(2)) NA = 0 L1 = 1 IW = 1 DO 116 K1=1,NF - IP = IFAC(K1+2) + IP = INT(IFAC(K1+2)) L2 = IP*L1 IDO = N/L2 IDL1 = IDO*L1 @@ -401,13 +401,13 @@ SUBROUTINE RFFTB1 (N,C,CH,WA,IFAC) C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO SUBROUTINE RFFTF1 (N,C,CH,WA,IFAC) REAL CH(*) ,C(*) ,WA(*) ,IFAC(*) - NF = IFAC(2) + NF = INT(IFAC(2)) NA = 1 L2 = N IW = N DO 111 K1=1,NF KH = NF-K1 - IP = IFAC(KH+3) + IP = INT(IFAC(KH+3)) L1 = L2/IP IDO = N/L2 IDL1 = IDO*L1 @@ -473,13 +473,21 @@ SUBROUTINE RFFTI1 (N,WA,IFAC) NF = 0 J = 0 101 J = J+1 - IF (J-4) 102,102,103 - 102 NTRY = NTRYH(J) + IF ((J-4).LE.0) THEN + GO TO 102 + ELSE + GO TO 103 + ENDIF + 102 NTRY = INT(NTRYH(J)) GO TO 104 103 NTRY = NTRY+2 104 NQ = NL/NTRY NR = NL-NTRY*NQ - IF (NR) 101,105,101 + IF (NR.EQ.0) THEN + GO TO 105 + ELSE + GO TO 101 + ENDIF 105 NF = NF+1 IFAC(NF+2) = NTRY NL = NQ @@ -501,7 +509,7 @@ SUBROUTINE RFFTI1 (N,WA,IFAC) IF (NFM1 .EQ. 0) RETURN !OCL NOVREC DO 110 K1=1,NFM1 - IP = IFAC(K1+2) + IP = INT(IFAC(K1+2)) LD = 0 L2 = L1*IP IDO = N/L2 @@ -542,7 +550,13 @@ SUBROUTINE RADB2 (IDO,L1,CC,CH,WA1) CH(1,K,1) = CC(1,1,K)+CC(IDO,2,K) CH(1,K,2) = CC(1,1,K)-CC(IDO,2,K) 101 CONTINUE - IF (IDO-2) 107,105,102 + IF (IDO.LT.2) THEN + GO TO 107 + ELSEIF (IDO.EQ.2) THEN + GO TO 105 + ELSE + GO TO 102 + ENDIF 102 IDP2 = IDO+2 !OCL NOVREC DO 104 K=1,L1 @@ -638,7 +652,13 @@ SUBROUTINE RADB4 (IDO,L1,CC,CH,WA1,WA2,WA3) CH(1,K,3) = TR2-TR3 CH(1,K,4) = TR1+TR4 101 CONTINUE - IF (IDO-2) 107,105,102 + IF (IDO.LT.2) THEN + GO TO 107 + ELSEIF (IDO.EQ.2) THEN + GO TO 105 + ELSE + GO TO 102 + ENDIF 102 IDP2 = IDO+2 !OCL NOVREC DO 104 K=1,L1 @@ -958,7 +978,13 @@ SUBROUTINE RADF2 (IDO,L1,CC,CH,WA1) CH(1,1,K) = CC(1,K,1)+CC(1,K,2) CH(IDO,2,K) = CC(1,K,1)-CC(1,K,2) 101 CONTINUE - IF (IDO-2) 107,105,102 + IF (IDO.LT.2) THEN + GO TO 107 + ELSEIF (IDO.EQ.2) THEN + GO TO 105 + ELSE + GO TO 102 + ENDIF 102 IDP2 = IDO+2 DO 104 K=1,L1 DO 103 I=3,IDO,2 @@ -1048,7 +1074,13 @@ SUBROUTINE RADF4 (IDO,L1,CC,CH,WA1,WA2,WA3) CH(IDO,2,K) = CC(1,K,1)-CC(1,K,3) CH(1,3,K) = CC(1,K,4)-CC(1,K,2) 101 CONTINUE - IF (IDO-2) 107,105,102 + IF (IDO.LT.2) THEN + GO TO 107 + ELSEIF (IDO.EQ.2) THEN + GO TO 105 + ELSE + GO TO 102 + ENDIF 102 IDP2 = IDO+2 !OCL NOVREC DO 104 K=1,L1 diff --git a/src/ncpus.F b/src/ncpus.F index 2995c473..644040b1 100644 --- a/src/ncpus.F +++ b/src/ncpus.F @@ -21,16 +21,17 @@ C> C> @author Iredell @date 94-08-19 FUNCTION NCPUS() - INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS,OMP_GET_THREAD_NUM + INTEGER TID C Obtain thread number #ifdef OPENMP + INTEGER OMP_GET_NUM_THREADS,OMP_GET_THREAD_NUM !$OMP PARALLEL PRIVATE(TID) TID = OMP_GET_THREAD_NUM() ! PRINT *, '...............thread # ', TID - if (TID. eq. 0) then + if (TID. eq. 0) then NCPUS=OMP_GET_NUM_THREADS() ! PRINT *, 'totaly #------------------- of threads = ',NCPUS - endif + endif !$OMP END PARALLEL #else TID = 0 diff --git a/src/spectral_interp_mod.F90 b/src/spectral_interp_mod.F90 index 4cb87b12..770f873c 100644 --- a/src/spectral_interp_mod.F90 +++ b/src/spectral_interp_mod.F90 @@ -917,7 +917,7 @@ SUBROUTINE POLATEV4_grib2(IPOPT,IGDTNUMI,IGDTMPLI,IGDTLENI, & INTEGER :: K, MAXWV, N, NI, NJ, NPS ! REAL :: DLAT, DLON, DLATO, DLONO, DE, DR, DY - REAL :: DUM, E2, H, HI, HJ, DUMM(1) + REAL :: E2, H, HI, HJ, DUMM(1) REAL :: ORIENT, RERTH, SLAT REAL :: RLAT1, RLON1, RLAT2, RLON2, RLATI REAL :: UROT, VROT, UO2(MO,KM),VO2(MO,KM) @@ -1247,7 +1247,7 @@ SUBROUTINE POLATEV4_grib1(IPOPT,KGDSI,KGDSO,MI,MO,KM,IBI,UI,VI, & INTEGER :: K, MAXWV, N, NI, NJ, NO, NPS ! REAL :: DLAT, DLON, DLATO, DLONO, DE, DR, DY - REAL :: DUM, H, HI, HJ, DUMM(1) + REAL :: H, HI, HJ, DUMM(1) REAL :: ORIENT REAL :: RLAT1, RLON1, RLAT2, RLON2, RLATI REAL :: UROT, VROT, UO2(MO,KM),VO2(MO,KM) diff --git a/src/spffte.f b/src/spffte.f index 0dbb39ce..9d1e2a31 100644 --- a/src/spffte.f +++ b/src/spffte.f @@ -55,8 +55,7 @@ SUBROUTINE SPFFTE(IMAX,INCW,INCG,KMAX,W,G,IDIR,AFFT) INTEGER:: INIT,INC2X,INC2Y,N,M,ISIGN,NAUX1,NAUX2,NAUX3 C ==EM== ^(4) REAL:: SCALE - REAL(8):: AUX2(20000+2*IMAX),AUX3 - REAL :: AUX2R(20000+2*IMAX),AUX3R + REAL :: AUX2(20000+2*IMAX),AUX3 INTEGER:: IACR,IARC NAUX1=25000+2*IMAX @@ -65,8 +64,6 @@ SUBROUTINE SPFFTE(IMAX,INCW,INCG,KMAX,W,G,IDIR,AFFT) IACR=1 IARC=1+NAUX1 AFFTR=REAL(AFFT) - AUX2R=REAL(AUX2) - AUX3R=REAL(AUX3) C INITIALIZATION. C FILL AUXILIARY ARRAYS WITH TRIGONOMETRIC DATA @@ -81,10 +78,10 @@ SUBROUTINE SPFFTE(IMAX,INCW,INCG,KMAX,W,G,IDIR,AFFT) SCALE=1. IF(DIGITS(1.).LT.DIGITS(1._8)) THEN CALL SCRFT(INIT,W,INC2X,G,INC2Y,N,M,ISIGN,SCALE, - & AFFTR(IACR),NAUX1,AUX2R,NAUX2,AUX3R,NAUX3) + & AFFTR(IACR),NAUX1,AUX2,NAUX2,AUX3,NAUX3) ELSE CALL DCRFT(INIT,W,INC2X,G,INC2Y,N,M,ISIGN,SCALE, - & AFFTR(IACR),NAUX1,AUX2R,NAUX2) + & AFFTR(IACR),NAUX1,AUX2,NAUX2) ENDIF INIT=1 INC2X=INCG @@ -95,10 +92,10 @@ SUBROUTINE SPFFTE(IMAX,INCW,INCG,KMAX,W,G,IDIR,AFFT) SCALE=1./IMAX IF(DIGITS(1.).LT.DIGITS(1._8)) THEN CALL SRCFT(INIT,G,INC2X,W,INC2Y,N,M,ISIGN,SCALE, - & AFFTR(IARC),NAUX1,AUX2R,NAUX2,AUX3R,NAUX3) + & AFFTR(IARC),NAUX1,AUX2,NAUX2,AUX3,NAUX3) ELSE CALL DRCFT(INIT,G,INC2X,W,INC2Y,N,M,ISIGN,SCALE, - & AFFTR(IARC),NAUX1,AUX2R,NAUX2) + & AFFTR(IARC),NAUX1,AUX2,NAUX2) ENDIF C FOURIER TO PHYSICAL TRANSFORM. @@ -112,10 +109,10 @@ SUBROUTINE SPFFTE(IMAX,INCW,INCG,KMAX,W,G,IDIR,AFFT) SCALE=1. IF(DIGITS(1.).LT.DIGITS(1._8)) THEN CALL SCRFT(INIT,W,INC2X,G,INC2Y,N,M,ISIGN,SCALE, - & AFFTR(IACR),NAUX1,AUX2R,NAUX2,AUX3R,NAUX3) + & AFFTR(IACR),NAUX1,AUX2,NAUX2,AUX3,NAUX3) ELSE CALL DCRFT(INIT,W,INC2X,G,INC2Y,N,M,ISIGN,SCALE, - & AFFTR(IACR),NAUX1,AUX2R,NAUX2) + & AFFTR(IACR),NAUX1,AUX2,NAUX2) ENDIF C PHYSICAL TO FOURIER TRANSFORM. @@ -129,13 +126,11 @@ SUBROUTINE SPFFTE(IMAX,INCW,INCG,KMAX,W,G,IDIR,AFFT) SCALE=1./IMAX IF(DIGITS(1.).LT.DIGITS(1._8)) THEN CALL SRCFT(INIT,G,INC2X,W,INC2Y,N,M,ISIGN,SCALE, - & AFFTR(IARC),NAUX1,AUX2R,NAUX2,AUX3R,NAUX3) + & AFFTR(IARC),NAUX1,AUX2,NAUX2,AUX3,NAUX3) ELSE CALL DRCFT(INIT,G,INC2X,W,INC2Y,N,M,ISIGN,SCALE, - & AFFTR(IARC),NAUX1,AUX2R,NAUX2) + & AFFTR(IARC),NAUX1,AUX2,NAUX2) ENDIF END SELECT AFFT=REAL(AFFTR,KIND=8) - AUX2=REAL(AUX2R,KIND=8) - AUX3=REAL(AUX3R,KIND=8) END SUBROUTINE diff --git a/src/splat.F b/src/splat.F index e6269640..19049402 100644 --- a/src/splat.F +++ b/src/splat.F @@ -64,7 +64,7 @@ SUBROUTINE SPLAT(IDRT,JMAX,SLAT,WLAT) $ 146.870307625, 150.011882457, 153.153458019, 156.295034268 / REAL:: DLT,D1=1. REAL AWORK((JMAX+1)/2,((JMAX+1)/2)),BWORK(((JMAX+1)/2)) - INTEGER:: JHE,JHO,J0=0, INFO + INTEGER:: JHE,JHO,INFO INTEGER IPVT((JMAX+1)/2) PARAMETER(PI=3.14159265358979,C=(1.-(2./PI)**2)*0.25) C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -101,8 +101,8 @@ SUBROUTINE SPLAT(IDRT,JMAX,SLAT,WLAT) ENDDO CDIR$ IVDEP DO J=1,JH - SLAT(J)=SLATD(J) - WLAT(J)=(2.*(1.-SLATD(J)**2))/(JMAX*PKM1(J))**2 + SLAT(J)=REAL(SLATD(J)) + WLAT(J)=REAL((2.*(1.-SLATD(J)**2))/(JMAX*PKM1(J))**2) SLAT(JMAX+1-J)=-SLAT(J) WLAT(JMAX+1-J)=WLAT(J) ENDDO diff --git a/src/splegend.f b/src/splegend.f index b862ca87..7c4f6727 100644 --- a/src/splegend.f +++ b/src/splegend.f @@ -47,12 +47,13 @@ SUBROUTINE SPLEGEND(I,M,SLAT,CLAT,EPS,EPSTOP,PLN,PLNTOP) REAL EPS((M+1)*((I+1)*M+2)/2),EPSTOP(M+1) REAL PLN((M+1)*((I+1)*M+2)/2),PLNTOP(M+1) REAL(KIND=SELECTED_REAL_KIND(15,45)):: DLN((M+1)*((I+1)*M+2)/2) + REAL :: TINYREAL=TINY(1.0), RDLN1, RDLN2 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C ITERATIVELY COMPUTE PLN WITHIN SPECTRAL DOMAIN AT POLE M1=M+1 M2=2*M+I+1 MX=(M+1)*((I+1)*M+2)/2 - IF(CLAT.EQ.0.) THEN + IF(ABS(CLAT).LT.TINYREAL) THEN DLN(1)=SQRT(0.5) IF(M.GT.0) THEN DLN(M1+1)=SQRT(0.75) @@ -78,10 +79,14 @@ SUBROUTINE SPLEGEND(I,M,SLAT,CLAT,EPS,EPSTOP,PLN,PLNTOP) C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C COMPUTE POLYNOMIALS OVER TOP OF SPECTRAL DOMAIN K=M1+1 - PLNTOP(1)=(SLAT*DLN(K-1)-EPS(K-1)*DLN(K-2))/EPSTOP(1) + RDLN1=REAL(DLN(K-1)) + RDLN2=REAL(DLN(K-2)) + PLNTOP(1)=(SLAT*RDLN1-EPS(K-1)*RDLN2)/EPSTOP(1) IF(M.GT.0) THEN K=M2+1 - PLNTOP(2)=(SLAT*DLN(K-1)-EPS(K-1)*DLN(K-2))/EPSTOP(2) + RDLN1=REAL(DLN(K-1)) + RDLN2=REAL(DLN(K-2)) + PLNTOP(2)=(SLAT*RDLN1-EPS(K-1)*RDLN2)/EPSTOP(2) DO L=2,M PLNTOP(L+1)=0. ENDDO @@ -119,13 +124,15 @@ SUBROUTINE SPLEGEND(I,M,SLAT,CLAT,EPS,EPSTOP,PLN,PLNTOP) DO L=0,M NML=M+1+(I-1)*L K=L*(2*M+(I-1)*(L-1))/2+L+NML+1 - PLNTOP(L+1)=(SLAT*DLN(K-1)-EPS(K-1)*DLN(K-2))/EPSTOP(L+1) + RDLN1=REAL(DLN(K-1)) + RDLN2=REAL(DLN(K-2)) + PLNTOP(L+1)=(SLAT*RDLN1-EPS(K-1)*RDLN2)/EPSTOP(L+1) ENDDO ENDIF C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C RETURN VALUES DO K=1,MX - PLN(K)=DLN(K) + PLN(K)=REAL(DLN(K)) ENDDO RETURN END diff --git a/src/spsynth.f b/src/spsynth.f index 4e0feb99..3bbd6273 100644 --- a/src/spsynth.f +++ b/src/spsynth.f @@ -41,6 +41,7 @@ SUBROUTINE SPSYNTH(I,M,IM,IX,NC,NCTOP,KM,CLAT,PLN,PLNTOP,MP, INTEGER MP(KM) REAL SPC(NC,KM),SPCTOP(NCTOP,KM) REAL F(IX,2,KM) + REAL :: TINYREAL=TINY(1.0) C ZERO OUT FOURIER COEFFICIENTS. DO K=1,KM @@ -55,7 +56,7 @@ SUBROUTINE SPSYNTH(I,M,IM,IX,NC,NCTOP,KM,CLAT,PLN,PLNTOP,MP, C SYNTHESIS OVER POLE. C INITIALIZE FOURIER COEFFICIENTS WITH TERMS OVER TOP OF THE SPECTRUM. C INITIALIZE EVEN AND ODD POLYNOMIALS SEPARATELY. - IF(CLAT.EQ.0) THEN + IF(ABS(CLAT).LT.TINYREAL) THEN LTOPE=MOD(M+1+I,2) !C$OMP PARALLEL DO PRIVATE(LB,LE,L,KS,KP,N,F1R,F1I) DO K=1,KM diff --git a/src/sptez.f b/src/sptez.f index 87db1063..c168f56a 100644 --- a/src/sptez.f +++ b/src/sptez.f @@ -61,7 +61,7 @@ SUBROUTINE SPTEZ(IROMB,MAXWV,IDRT,IMAX,JMAX,WAVE,GRID,IDIR) JB=1 JE=(JMAX+1)/2 JC=NCPUS() -! print *, " EM: SPTEZ:::JJJJJJJJJJJJJJJJJJJCCCCCCCCCCC=" ,JC +! print *, " EM: SPTEZ:::JJJJJJJJJJJJJJJJJJJCCCCCCCCCCC=" ,JC IF(IDIR.LT.0) WAVE=0 CALL SPTRANF(IROMB,MAXWV,IDRT,IMAX,JMAX,1, diff --git a/src/sptgpm.f b/src/sptgpm.f index 44325d27..7d19092d 100644 --- a/src/sptgpm.f +++ b/src/sptgpm.f @@ -64,7 +64,6 @@ SUBROUTINE SPTGPM(IROMB,MAXWV,KMAX,MI,MJ, REAL PLN((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),PLNTOP(MAXWV+1) REAL F(2*MAXWV+3,2,KMAX) REAL CLAT(MJ),SLAT(MJ),CLON(MAXWV,MI),SLON(MAXWV,MI) - PARAMETER(RERTH=6.3712E6) PARAMETER(PI=3.14159265358979,DPR=180./PI) C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C CALCULATE PRELIMINARY CONSTANTS diff --git a/src/sptgpmv.f b/src/sptgpmv.f index c153a09c..298fc5e1 100644 --- a/src/sptgpmv.f +++ b/src/sptgpmv.f @@ -72,7 +72,6 @@ SUBROUTINE SPTGPMV(IROMB,MAXWV,KMAX,MI,MJ, REAL PLN((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),PLNTOP(MAXWV+1) REAL F(2*MAXWV+3,2,2*KMAX) REAL CLAT(MJ),SLAT(MJ),CLON(MAXWV,MI),SLON(MAXWV,MI) - PARAMETER(RERTH=6.3712E6) PARAMETER(PI=3.14159265358979,DPR=180./PI) C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C CALCULATE PRELIMINARY CONSTANTS diff --git a/src/sptranf.f b/src/sptranf.f index 18f5ca32..a8e7b69b 100644 --- a/src/sptranf.f +++ b/src/sptranf.f @@ -98,7 +98,7 @@ SUBROUTINE SPTRANF(IROMB,MAXWV,IDRT,IMAX,JMAX,KMAX, IF(IDIR.GT.0) THEN C$OMP PARALLEL DO PRIVATE(AFFT_TMP,KWS,WTOP,G,IJKN,IJKS) DO K=1,KMAX - AFFT_TMP=AFFT + AFFT_TMP=AFFT KWS=(K-1)*KW WTOP=0 DO J=JB,JE @@ -129,7 +129,7 @@ SUBROUTINE SPTRANF(IROMB,MAXWV,IDRT,IMAX,JMAX,KMAX, ELSE C$OMP PARALLEL DO PRIVATE(AFFT_TMP,KWS,WTOP,G,IJKN,IJKS) DO K=1,KMAX - AFFT_TMP=AFFT + AFFT_TMP=AFFT KWS=(K-1)*KW WTOP=0 DO J=JB,JE diff --git a/src/sptranfv.f b/src/sptranfv.f index 6361c343..74b530f3 100644 --- a/src/sptranfv.f +++ b/src/sptranfv.f @@ -107,7 +107,7 @@ SUBROUTINE SPTRANFV(IROMB,MAXWV,IDRT,IMAX,JMAX,KMAX, IF(IDIR.GT.0) THEN C$OMP PARALLEL DO PRIVATE(AFFT_TMP,KWS,W,WTOP,G,IJKN,IJKS) DO K=1,KMAX - AFFT_TMP=AFFT + AFFT_TMP=AFFT KWS=(K-1)*KW CALL SPDZ2UV(IROMB,MAXWV,ENN1,ELONN1,EON,EONTOP, & WAVED(KWS+1),WAVEZ(KWS+1), @@ -149,7 +149,7 @@ SUBROUTINE SPTRANFV(IROMB,MAXWV,IDRT,IMAX,JMAX,KMAX, ELSE C$OMP PARALLEL DO PRIVATE(AFFT_TMP,KWS,W,WTOP,G,IJKN,IJKS,WINC) DO K=1,KMAX - AFFT_TMP=AFFT + AFFT_TMP=AFFT KWS=(K-1)*KW W=0 WTOP=0 diff --git a/src/sptrunmv.f b/src/sptrunmv.f index a9b5c92f..3cfe165c 100644 --- a/src/sptrunmv.f +++ b/src/sptrunmv.f @@ -97,7 +97,6 @@ SUBROUTINE SPTRUNMV(IROMB,MAXWV,IDRTI,IMAXI,JMAXI,KMAX,MI,MJ, LOGICAL LUV,LDZ,LPS REAL GRIDUI(*),GRIDVI(*) REAL UM(*),VM(*),DM(*),ZM(*),PM(*),SM(*) - REAL W((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,KMAX) REAL EPS((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EPSTOP(MAXWV+1) REAL ENN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2) REAL ELONN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2) diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 5393d926..ab5236c2 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -35,11 +35,6 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel|IntelLLVM)$") set(CMAKE_C_FLAGS "-std=c99") endif() -# Set compiler flags for GNU. -if(${CMAKE_Fortran_COMPILER_ID} MATCHES "^(GNU)$" AND ${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 10) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w -fallow-argument-mismatch -fallow-invalid-boz") -endif() - foreach(kind ${kinds}) string(TOUPPER ${kind} kind_definition) diff --git a/tests/test_fft.F90 b/tests/test_fft.F90 index 738de531..91a3d04b 100644 --- a/tests/test_fft.F90 +++ b/tests/test_fft.F90 @@ -30,13 +30,13 @@ program test_fft ! then check if frequency and DC component match the test signal. subroutine test_fft_real_to_complex() real(precision) :: amplitude, freq_hz, t, cosine, dt, sample_rate_hz, dc_component, df, f, magnitude - real(real64) :: AFFT(50000+4*IMAX) - real(precision), allocatable :: w(:,:), g(:,:) + real(precision), allocatable :: w(:,:), g(:,:), afft(:) integer :: i complex :: dft real :: max_freq=-999.9, max_magnitude + allocate(afft(50000+4*imax)) ! Setup the test wave amplitude = 1.0 freq_hz = 12.0 @@ -88,11 +88,10 @@ end subroutine test_fft_real_to_complex ! Run synthetic test array through FFT and run results through inverse FFT ! to obtain the original array subroutine test_fft_complex_to_real() - real(real64) :: AFFT(50000+4*IMAX) - real(precision), allocatable :: w(:,:), g(:,:), g_new(:,:) + real(precision), allocatable :: w(:,:), g(:,:), g_new(:,:), afft(:) integer :: i - allocate(w(2*incw, kmax), g(incg, kmax), g_new(incg, kmax)) + allocate(w(2*incw, kmax), g(incg, kmax), g_new(incg, kmax), afft(50000+4*imax)) ! Setup test array with synthetic data do i = 1, imax diff --git a/tests/test_splaplac.F90 b/tests/test_splaplac.F90 index 18d5018f..c7f6152b 100644 --- a/tests/test_splaplac.F90 +++ b/tests/test_splaplac.F90 @@ -8,7 +8,7 @@ PROGRAM TEST_SPLAPLAC IMPLICIT NONE INTEGER I, M, J, QSIZE, QD2SIZE - REAL, ALLOCATABLE :: ENN1(:), Q(:), QD2(:), QREF(:), REF(:), QD2REF(:) + REAL, ALLOCATABLE :: ENN1(:), Q(:), QD2(:), QREF(:), QD2REF(:) REAL :: TOL=1E-7 M=2 diff --git a/tests/test_splat.F90 b/tests/test_splat.F90 index cb564def..7df78ebb 100644 --- a/tests/test_splat.F90 +++ b/tests/test_splat.F90 @@ -11,25 +11,25 @@ program test_splat integer :: j, jj, jmax, ref_j(5) real :: slat(584), wlat(584), ref_slat(5), ref_wlat(5) - real :: tini=1e-5 + real :: tini=1e-5, tinyreal=tiny(1.0) jmax = 584 ! t382 grid call splat(0, jmax, slat, wlat) - if (slat(1) /= 1d0) then + if (abs(slat(1)-1d0).gt.tinyreal) then error stop "slat(1) should equal 1.0" endif - if(slat(jmax) /= -1d0) then + if(abs(slat(jmax)+1).gt.tinyreal) then error stop "slat(jmax) should equal -1.0" endif - if(wlat(1) /= 0d0) then + if(abs(wlat(1)).gt.tinyreal) then error stop "wlat(1) should equal 0.0" endif - if(wlat(jmax) /= 0d0) then + if(abs(wlat(jmax)).gt.tinyreal) then error stop "wlat(jmax) should equal 0.0" endif diff --git a/tests/test_sptezv.F90 b/tests/test_sptezv.F90 index e1979b07..b4cfd30e 100644 --- a/tests/test_sptezv.F90 +++ b/tests/test_sptezv.F90 @@ -11,7 +11,7 @@ program test_sptezv #ifdef KIND_d integer,parameter:: iromb=0,maxwv=7 integer,parameter:: idrtg=4,idrte=0,imax=16,jmaxg=8,jmaxe=17 - real(real64) :: MAX_DIFF = 1d-9 + real(real64) :: MAX_DIFF = 1e-9 call test_scalar(iromb,maxwv,idrtg,imax,jmaxg) call test_scalar(iromb,maxwv,idrte,imax,jmaxe)