[Bug fortran/30902] gfortran produces wrong result with code using generic interface block

["pault at gcc dot gnu dot org" <gcc-bugzilla at gcc dot gnu dot org>]

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