------- 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
