Probable bug in PGI 15.4 Fortran compiler

C   Possible bug in Portland Group 15.4 Fortran compiler.
C   Compile with
C     pgfortran -O1 -g -o kwktest_O1 kwktest.F
C     pgfortran -O2 -g -o kwktest_O2 kwktest.F
C   Run the codes:
C      kwktest_O1 > kwktest_O1.out
C      kwktest_O2 > kwktest_O2.out
C
C   The two output files are different, diff kwktest_O[12].out gives:
C48c48
C<    256.4083       256.4083       256.4083       256.4083       256.4083
C---
C>    266.6667       266.6667       266.6667       266.6667       256.4083
C
C   I believe the output from the -O1 compilation is correct, and
C   the output from the -O2 compilation is incorrect.
C   Using the gfortran compiler gives the same answer as pgfortran with -O1.
C   This problem does not occur with the PGI 15.1 compiler, PGI 15.1 with
C   -O1 and -O2 give identical correct output.
C
C   I believe the problem arises from an incorrect handling of the IF clause
C   inside the double loop in subroutine KWFKWK:
C      DO L = LS,LE
C      DO J = JS,JE
C         ...
C         IF (IBWF(J,L).EQ.-1) THEN
C            ...
C         ELSE
C            ...
C         ENDIF
C         ...
C      ENDDO
C      ENDDO
C
C   Compiler used:
C     pgfortran -V
C     pgfortran 15.4-0 64-bit target on x86-64 Linux -tp sandybridge
C
      PROGRAM KWKTEST
C
      IMPLICIT NONE
      INTEGER, PARAMETER :: JD=621, KD=11, LD=3
      INTEGER, PARAMETER :: JS=221, JE=226, LS=1, LE=3
      REAL*8,  PARAMETER :: REY=25000.
C
      INTEGER :: J,K,L,KP
      INTEGER, DIMENSION(JS:JE,LS:LE) :: IBWF
      REAL*8,  DIMENSION(JS:JE,LS:LE) :: YWALL,USTAR,VMUT1
      REAL*8,  DIMENSION(JD,KD,LD) :: RHO
      REAL*8,  DIMENSION(JD,KD,LD,2) :: QT
      REAL*8,  DIMENSION(JD,KD,LD) :: VMUL
      REAL*8,  DIMENSION(JD,KD,LD) :: VMUT
C
C
      RHO(:,:,:)  =  1.D0
      YWALL(:,:)  =  0.01D0
      USTAR(:,:)  =  0.3129165D0
      VMUT1(:,:)  = 13.76896D0
      IBWF(:,:)   = -1
      QT(:,:,:,1) =  0.D0
      QT(:,:,:,2) = 266.6667D0
      VMUL(:,:,:) = 1.D0
      VMUT(:,:,:) = 0.0125D0
      K   = 1
      KP  = 2
C
      CALL KWFKWK ( JS,JE,K,KP,LS,LE,REY,
     &              IBWF,YWALL,USTAR,VMUT1,
     &              RHO,QT,VMUL,VMUT,JD,KD,LD )
C
C
      END PROGRAM KWKTEST
C
C
      SUBROUTINE KWFKWK ( JS,JE,K,KP,LS,LE,REY,
     &                    IBWF,YWALL,USTAR,VMUT1,
     &                    RHO,QT,VMUL,VMUT,JD,KD,LD )
      IMPLICIT NONE
      REAL*8,  PARAMETER :: KAPPA=0.41D0
      REAL*8,  PARAMETER :: CMU=0.09D0
      REAL*8,  PARAMETER :: BETAST=0.09D0
      REAL*8,  PARAMETER :: CON1=60.
      REAL*8,  PARAMETER :: MUTMIN_WF=0.001D0
C
      INTEGER, INTENT (IN) :: JS,JE,K,KP,LS,LE,JD,KD,LD
      REAL*8,  INTENT (IN) :: REY
      INTEGER, DIMENSION(JS:JE,LS:LE), INTENT (IN) :: IBWF
      REAL*8,  DIMENSION(JS:JE,LS:LE), INTENT (IN) :: YWALL,USTAR,VMUT1
      REAL*8,  DIMENSION(JD,KD,LD), INTENT (IN) :: RHO
      REAL*8,  DIMENSION(JD,KD,LD,2), INTENT (INOUT) :: QT
      REAL*8,  DIMENSION(JD,KD,LD), INTENT (IN) :: VMUL
      REAL*8,  DIMENSION(JD,KD,LD), INTENT (INOUT) :: VMUT
C
      INTEGER :: J,L
      REAL*8  :: REI
      REAL*8  :: VNUW,RDIST,OMEGAW,TEMP1,TEMP2
C
C
C   begin debug printing
      WRITE(*,"('Start KWFKWK, JD,KD,LD,JS,JE,LS,LE=',7I5)")
     &                   JD,KD,LD,JS,JE,LS,LE
      L  = 2
      WRITE(*,"('IBWF')")
      DO J = JS,JE,10
         WRITE(*,"(10I5)") IBWF(J:MIN(J+9,JE),L)
      ENDDO
      WRITE(*,"('YWALL')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") YWALL(J:MIN(J+4,JE),L)
      ENDDO
      WRITE(*,"('USTAR')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") USTAR(J:MIN(J+4,JE),L)
      ENDDO
      WRITE(*,"('VMUT1')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") VMUT1(J:MIN(J+4,JE),L)
      ENDDO
      WRITE(*,"('RHO(,K,L)')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") RHO(J:MIN(J+4,JE),K,L)
      ENDDO
      WRITE(*,"('RHO(,KP,L)')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") RHO(J:MIN(J+4,JE),KP,L)
      ENDDO
      WRITE(*,"('VMUL')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") VMUL(J:MIN(J+4,JE),K,L)
      ENDDO
      WRITE(*,"('VMUT')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") VMUT(J:MIN(J+4,JE),K,L)
      ENDDO
      WRITE(*,"('QT(.,K,.,1)')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") QT(J:MIN(J+4,JE),K,L,1)
      ENDDO
      WRITE(*,"('QT(.,K,.,2)')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") QT(J:MIN(J+4,JE),K,L,2)
      ENDDO
C   end debug printing
      REI        = 1./REY
      DO L = LS,LE
      DO J = JS,JE
         VNUW          = REI*VMUL(J,K,L)/RHO(J,K,L)
         RDIST         = 1./YWALL(J,L)
         OMEGAW        = (CON1/BETAST)*(VNUW*RDIST**2)
         IF (IBWF(J,L).EQ.-1) THEN
            VMUT(J,KP,L)  = 0.6*MAX(VMUT1(J,L),MUTMIN_WF)
            TEMP1         = (6./0.075)*(VNUW*RDIST**2)
            TEMP2         = USTAR(J,L)*RDIST/(SQRT(CMU)*KAPPA)
            QT(J,KP,L,2)  = SQRT(TEMP1**2 + TEMP2**2)
            QT(J,KP,L,1)  = QT(J,KP,L,2)*REI*VMUT(J,KP,L)/RHO(J,KP,L)
            QT(J,K,L,2)   = 0.
            QT(J,KP,L,2)  = MIN(QT(J,KP,L,2),OMEGAW)
         ELSE
            QT(J,K,L,2)   = OMEGAW
         ENDIF
         QT(J,K,L,1)   = 0.
         VMUT(J,K,L)   = 0.
      ENDDO
      ENDDO
C   begin debug printing
      WRITE(*,"('End KWFKWK')")
      L   = 2
      WRITE(*,"('VMUT(K)')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") VMUT(J:MIN(J+4,JE),K,L)
      ENDDO
      WRITE(*,"('VMUT(KP)')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") VMUT(J:MIN(J+4,JE),KP,L)
      ENDDO
      WRITE(*,"('QT(.,K,.,1)')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") QT(J:MIN(J+4,JE),K,L,1)
      ENDDO
      WRITE(*,"('QT(.,K,.,2)')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") QT(J:MIN(J+4,JE),K,L,2)
      ENDDO
      WRITE(*,"('QT(.,KP,.,1)')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") QT(J:MIN(J+4,JE),KP,L,1)
      ENDDO
      WRITE(*,"('QT(.,KP,.,2)')")
      DO J = JS,JE,5
         WRITE(*,"(5G15.7)") QT(J:MIN(J+4,JE),KP,L,2)
      ENDDO
C   end debug printing
C
C
      RETURN
      END

Thanks Dennis. This looks like a problem with our new conditional vectorizer. Adding “-Mvect=nocond” works around the problem. I added TPR#21740 and sent on to engineering for further investigation.

  • Mat

TPR 21740 has been fixed in the current 15.7 release.
thanks,
dave