From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 9557 invoked by alias); 21 Feb 2007 08:51:20 -0000 Received: (qmail 9499 invoked by uid 48); 21 Feb 2007 08:51:09 -0000 Date: Wed, 21 Feb 2007 08:51:00 -0000 Message-ID: <20070221085109.9498.qmail@sourceware.org> X-Bugzilla-Reason: CC References: Subject: [Bug fortran/30902] gfortran produces wrong result with code using generic interface block In-Reply-To: Reply-To: gcc-bugzilla@gcc.gnu.org To: gcc-bugs@gcc.gnu.org From: "pault at gcc dot gnu dot org" Mailing-List: contact gcc-bugs-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-bugs-owner@gcc.gnu.org X-SW-Source: 2007-02/txt/msg02429.txt.bz2 ------- Comment #3 from pault at gcc dot gnu dot org 2007-02-21 08:51 ------- (In reply to comment #2) > (In reply to comment #0) > By the way, NAG f95 detects the interface/procedure mismatch also for the > original program as the interface and the subroutines are in the same file. > This same-file error detection is also planed for gfortran. > K'aro Deji, Or, more succinctly, the array in the interface is assumed shape, dimension (:), whereas you have an automatic array in the subroutine. Change to SUBROUTINE adsorb2(te, gam, adsor, scl, dqdt, dime, mode) IMPLICIT NONE INTEGER, INTENT(IN) :: mode, dime REAL, INTENT(IN), DIMENSION(:) :: gam, te REAL, INTENT(OUT), DIMENSION(:) :: adsor REAL, DIMENSION(:), OPTIONAL :: dqdt, scl REAL, DIMENSION(dime) :: kstar, param REAL :: rhog, rgasv and your program will work fine. As Tobias says, we will be adding the means to diagnose this, just as soon as yours truly gets some time:) I would strongly recommend that your regroup your subroutiens and the interface into a module, thusly: module adsorbers interface adsorb module procedure adsorb, adsorb2 end interface adsorb contains SUBROUTINE adsorb2(te, gam, adsor, scl, dqdt, dime, mode) IMPLICIT NONE INTEGER, INTENT(IN) :: mode, dime REAL, INTENT(IN), DIMENSION(:) :: gam, te REAL, INTENT(OUT), DIMENSION(:) :: adsor REAL, DIMENSION(:), OPTIONAL :: dqdt, scl REAL, DIMENSION(dime) :: kstar, param REAL :: rhog, rgasv REAL, PARAMETER :: as = 1.7E4, mi = 2.84E-7, ko = 7.54E-9, re = 0.4734 rhog = 1650.0 rgasv = 0.461510E+03 kstar = ko * exp(2697.2 / te) param = kstar * gam * rgasv * te adsor = rhog * as * mi * (param / (1.0 + param))**re if (mode == 2) return scl = re * adsor / ((1.0 + param) * gam) if (mode == 1) return dqdt = re * adsor * (te-2697.2) / ((1.0 + param)*te*te) RETURN END SUBROUTINE adsorb2 SUBROUTINE adsorb(te, gam, adsor, scl, dqdt, dime, mode) IMPLICIT NONE INTEGER, INTENT(IN) :: mode, dime REAL, INTENT(IN) :: gam, te REAL, INTENT(OUT) :: adsor REAL, OPTIONAL :: dqdt, scl REAL :: kstar, param REAL :: rhog, rgasv REAL, PARAMETER :: as = 1.7E4, mi = 2.84E-7, ko = 7.54E-9, re = 0.4734 rhog = 1650.0 rgasv = 0.461510E+03 kstar = ko * exp(2697.2 / te) param = kstar * gam * rgasv * te adsor = rhog * as * mi * (param / (1.0 + param))**re if (mode == 2) return scl = re * adsor / ((1.0 + param) * gam) if (mode == 1) return dqdt = re * adsor * (te-2697.2) / ((1.0 + param)*te*te) RETURN END SUBROUTINE adsorb end module adsorbers PROGRAM adsorb_test use adsorbers IMPLICIT NONE REAL, DIMENSION(10) :: tsl, gamm, adwat, wsc INTEGER :: dime, mode, ns, k REAL :: gams, ts, adwatg ns = 10 do k = 1,ns tsl(k) = 180.0 gamm(k) = 1.50E-6 enddo gams = gamm(1) ts = tsl(1) call adsorb(ts, gams, adwatg, dime = 1, mode = 2) call adsorb(tsl, gamm, adwat, wsc, dime = ns, mode = 1) do k = 1,ns write(*,*) tsl(k), gamm(k), adwat(k) enddo write (*,*) "---------" write(*,*) ts, gams, adwatg stop END PROGRAM adsorb_test Odabo Paul -- http://gcc.gnu.org/bugzilla/show_bug.cgi?id=30902