Question

我试图编译一个fortran模块Y，它包含一个函数和一个子程序，它们都调用相同的子程序X.当编译这个模块时，我得到以下错误：

array_lib.F90(70): error #8032: Generic procedure reference has two or
more specific procedure with the same type/rank/keyword signature. [MRGRNK]
        CALL mrgrnk(list,idx)
-------------^
array_lib.F90(141): error #8032: Generic procedure reference has two or
more specific procedure with the same type/rank/keyword signature. [MRGRNK]
        CALL mrgrnk(xarr,ist)

有人可以解释一下这里发生了什么。我不明白什么是错的？

我很欣赏这方面的一些见解。

代码：

MODULE array_lib
USE PARKIND1  ,ONLY : JPIM, JPIB, JPRB

IMPLICIT NONE

CONTAINS

FUNCTION infind(list,val,sort,dist)
USE m_mrgrnk
IMPLICIT NONE

! ----- INPUTS -----
REAL(KIND=JPRB), DIMENSION(:), INTENT(IN) :: list
REAL(KIND=JPRB), INTENT(IN) :: val
INTEGER, INTENT(IN), OPTIONAL :: sort

! ----- OUTPUTS -----
INTEGER(JPIM) :: infind
REAL(KIND=JPRB), INTENT(OUT), OPTIONAL :: dist

! ----- INTERNAL -----
REAL(KIND=JPRB), DIMENSION(SIZE(list)) :: lists
INTEGER(JPIM) :: nlist, result, tmp(1), sort_list
INTEGER(JPIM), DIMENSION(SIZE(list)) :: mask, idx

IF (PRESENT(sort)) THEN
    sort_list = sort
ELSE
    sort_list = 0
END IF

nlist = SIZE(list)
IF (sort_list == 1) THEN
    CALL mrgrnk(list,idx)
    lists = list(idx)
ELSE
    lists = list
END IF

IF (val >= lists(nlist)) THEN
    result = nlist
ELSE IF (val <= lists(1)) THEN
    result = 1
ELSE
    mask(:) = 0
    WHERE (lists < val) mask = 1
    tmp = MINLOC(mask,1)
    IF (ABS(lists(tmp(1)-1)-val) < ABS(lists(tmp(1))-val)) THEN
        result = tmp(1) - 1
    ELSE
        result = tmp(1)
    END IF
END IF
IF (PRESENT(dist)) dist = lists(result)-val
IF (sort_list == 1) THEN
    infind = idx(result)
ELSE
    infind = result
END IF

END FUNCTION infind

! ----------------------------------------------------------------------------
! SUBROUTINE LIN_INTERPOLATE
! ----------------------------------------------------------------------------
SUBROUTINE lin_interpolate(yarr,xarr,yyarr,xxarr,tol)
    USE m_mrgrnk
    IMPLICIT NONE

! ----- INPUTS -----
    REAL(KIND=JPRB), DIMENSION(:), INTENT(IN) :: yarr, xarr, xxarr
    REAL(KIND=JPRB), INTENT(IN) :: tol

! ----- OUTPUTS -----
    REAL(KIND=JPRB), DIMENSION(SIZE(xxarr)), INTENT(OUT) :: yyarr

! ----- INTERNAL -----
    REAL(KIND=JPRB), DIMENSION(SIZE(xarr)) :: ysort, xsort
    INTEGER(JPIM), DIMENSION(SIZE(xarr)) :: ist
    INTEGER(JPIM) :: nx, nxx, i, iloc
    REAL(KIND=JPRB) :: d, m

    nx = SIZE(xarr)
    nxx = SIZE(xxarr)

! // xsort, ysort are sorted versions of xarr, yarr
    CALL mrgrnk(xarr,ist)
    ysort = yarr(ist)
    xsort = xarr(ist)

    DO i=1,nxx
        iloc = infind(xsort,xxarr(i),dist=d)
        IF (d > tol) THEN
            PRINT *, 'interpolation error'
            STOP
        END IF
        IF (iloc == nx) THEN
        !     :: set to the last value
            yyarr(i) = ysort(nx)
        ELSE
        !     :: is there another CLOSEby value?
            IF (ABS(xxarr(i)-xsort(iloc+1)) < 2*tol) THEN
            !       :: yes, DO a linear interpolation
                m = (ysort(iloc+1)-ysort(iloc))/(xsort(iloc+1)-xsort(iloc))
                yyarr(i) = ysort(iloc) + m*(xxarr(i)-xsort(iloc))
            ELSE
            !       :: no, set to the only nearby value
                yyarr(i) = ysort(iloc)
            END IF
        END IF
    END DO

 END SUBROUTINE lin_interpolate

 END MODULE array_lib

MODULE M_MRGRNK：

MODULE m_mrgrnk
USE PARKIND1  ,ONLY : JPIM, JPIB, JPRB

PUBLIC :: mrgrnk
!PRIVATE :: kdp
PRIVATE :: R_mrgrnk, I_mrgrnk, D_mrgrnk

INTERFACE mrgrnk
MODULE PROCEDURE D_mrgrnk, R_mrgrnk, I_mrgrnk
END INTERFACE mrgrnk

CONTAINS

SUBROUTINE D_mrgrnk (XDONT, IRNGT)
REAL(KIND=JPRB), DIMENSION (:), INTENT (IN) :: XDONT
INTEGER(KIND=JPIM), DIMENSION (:), INTENT (OUT) :: IRNGT
REAL(KIND=JPRB):: XVALA, XVALB

INTEGER(KIND=JPIM), DIMENSION (SIZE(IRNGT)) :: JWRKT
INTEGER(KIND=JPIM) :: LMTNA, LMTNC, IRNG1, IRNG2
INTEGER(KIND=JPIM) :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB

NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
SELECT CASE (NVAL)
CASE (:0)
RETURN
CASE (1)
IRNGT (1) = 1
RETURN
CASE DEFAULT
CONTINUE
END SELECT

DO IIND = 2, NVAL, 2
    IF (XDONT(IIND-1) <= XDONT(IIND)) THEN
        IRNGT (IIND-1) = IIND - 1
        IRNGT (IIND) = IIND
    ELSE
        IRNGT (IIND-1) = IIND
        IRNGT (IIND) = IIND - 1
    END IF
END DO
IF (MODULO(NVAL, 2) /= 0) THEN
    IRNGT (NVAL) = NVAL
END IF

LMTNA = 2
LMTNC = 4

DO
IF (NVAL <= 2) EXIT

DO IWRKD = 0, NVAL - 1, 4
    IF ((IWRKD+4) > NVAL) THEN
        IF ((IWRKD+2) >= NVAL) EXIT

        IF (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) EXIT

        IF (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) THEN
            IRNG2 = IRNGT (IWRKD+2)
            IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
            IRNGT (IWRKD+3) = IRNG2
        ELSE
            IRNG1 = IRNGT (IWRKD+1)
            IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
            IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
            IRNGT (IWRKD+2) = IRNG1
        END IF
        EXIT
    END IF
    IF (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) CYCLE
    IF (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) THEN
        IRNG2 = IRNGT (IWRKD+2)
        IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
        IF (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) THEN
            IRNGT (IWRKD+3) = IRNG2
        ELSE
            IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
            IRNGT (IWRKD+4) = IRNG2
        END IF
    ELSE
        IRNG1 = IRNGT (IWRKD+1)
        IRNG2 = IRNGT (IWRKD+2)
        IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
        IF (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) THEN
            IRNGT (IWRKD+2) = IRNG1
            IF (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) THEN
                IRNGT (IWRKD+3) = IRNG2
            ELSE
                IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
                IRNGT (IWRKD+4) = IRNG2
            END IF
        ELSE
            IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
            IRNGT (IWRKD+3) = IRNG1
            IRNGT (IWRKD+4) = IRNG2
        END IF
    END IF
END DO

LMTNA = 4
EXIT
END DO

DO
IF (LMTNA >= NVAL) EXIT
IWRKF = 0
LMTNC = 2 * LMTNC

DO
IWRK = IWRKF
IWRKD = IWRKF + 1
JINDA = IWRKF + LMTNA
IWRKF = IWRKF + LMTNC
IF (IWRKF >= NVAL) THEN
    IF (JINDA >= NVAL) EXIT
    IWRKF = NVAL
END IF
IINDA = 1
IINDB = JINDA + 1

JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)

XVALA = XDONT (JWRKT(IINDA))
XVALB = XDONT (IRNGT(IINDB))

DO
IWRK = IWRK + 1

IF (XVALA > XVALB) THEN
    IRNGT (IWRK) = IRNGT (IINDB)
    IINDB = IINDB + 1
    IF (IINDB > IWRKF) THEN
    !  Only A still with unprocessed values
        IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
        EXIT
    END IF
    XVALB = XDONT (IRNGT(IINDB))
ELSE
    IRNGT (IWRK) = JWRKT (IINDA)
    IINDA = IINDA + 1
    IF (IINDA > LMTNA) EXIT! Only B still with unprocessed values
    XVALA = XDONT (JWRKT(IINDA))
END IF

END DO
END DO
LMTNA = 2 * LMTNA
END DO

RETURN

END SUBROUTINE D_mrgrnk

SUBROUTINE R_mrgrnk (XDONT, IRNGT)
REAL(KIND=JPRB), DIMENSION (:), INTENT (IN) :: XDONT
INTEGER(KIND=JPIM), DIMENSION (:), INTENT (OUT) :: IRNGT
REAL(KIND=JPRB) :: XVALA, XVALB

INTEGER(KIND=JPIM), DIMENSION (SIZE(IRNGT)) :: JWRKT
INTEGER(KIND=JPIM) :: LMTNA, LMTNC, IRNG1, IRNG2
INTEGER(KIND=JPIM) :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB

NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
SELECT CASE (NVAL)
CASE (:0)
RETURN
CASE (1)
IRNGT (1) = 1
RETURN
CASE DEFAULT
CONTINUE
END SELECT

DO IIND = 2, NVAL, 2
    IF (XDONT(IIND-1) <= XDONT(IIND)) THEN
        IRNGT (IIND-1) = IIND - 1
        IRNGT (IIND) = IIND
    ELSE
        IRNGT (IIND-1) = IIND
        IRNGT (IIND) = IIND - 1
    END IF
END DO
IF (MODULO(NVAL, 2) /= 0) THEN
    IRNGT (NVAL) = NVAL
END IF
LMTNA = 2
LMTNC = 4
DO
IF (NVAL <= 2) EXIT
DO IWRKD = 0, NVAL - 1, 4
    IF ((IWRKD+4) > NVAL) THEN
        IF ((IWRKD+2) >= NVAL) EXIT
        IF (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) EXIT
        IF (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) THEN
            IRNG2 = IRNGT (IWRKD+2)
            IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
            IRNGT (IWRKD+3) = IRNG2
        ELSE
            IRNG1 = IRNGT (IWRKD+1)
            IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
            IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
            IRNGT (IWRKD+2) = IRNG1
        END IF
        EXIT
    END IF
    IF (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
    IF (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) THEN
        IRNG2 = IRNGT (IWRKD+2)
        IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
        IF (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) THEN
        !   1 3 2 4
            IRNGT (IWRKD+3) = IRNG2
        ELSE
        !   1 3 4 2
            IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
            IRNGT (IWRKD+4) = IRNG2
        END IF
    ELSE

Answer 1

这里有一些问题：

与通用接口的特定接口必须是唯一的（类型/等级/等不能相同）。

具体来说，发生的事情是你的模块程序看起来并不明显，所以当你：

CALL mrgrnk(xarr,ist)

编译器无法确定要调用的特定模块过程。

您的通用界面是

INTERFACE mrgrnk
  MODULE PROCEDURE D_mrgrnk, R_mrgrnk, I_mrgrnk
END INTERFACE mrgrnk

并且您的特定接口是

SUBROUTINE D_mrgrnk (XDONT, IRNGT)
   REAL(KIND=JPRB), DIMENSION (:), INTENT (IN) :: XDONT
   INTEGER(KIND=JPIM), DIMENSION (:), INTENT (OUT) :: IRNGT
END SUBROUTINE

SUBROUTINE R_mrgrnk (XDONT, IRNGT)
   REAL(KIND=JPRB), DIMENSION (:), INTENT (IN) :: XDONT
   INTEGER(KIND=JPIM), DIMENSION (:), INTENT (OUT) :: IRNGT
END SUBROUTINE

SUBROUTINE I_mrgrnk (XDONT, IRNGT)
  INTEGER(KIND=JPIM), DIMENSION (:), INTENT (IN)  :: XDONT
  INTEGER(KIND=JPIM), DIMENSION (:), INTENT (OUT) :: IRNGT
END SUBROUTINE

正如您所看到的，D__mrgrnk和R_mrgrnk的接口是相同的，当您使用mrgrnk和REAL(KIND=JPRB)类型的参数调用INTEGER(KIND=JPIM)时，编译器无法确定要调用的过程。为了解决这个问题，您需要将参数的类型区分为D__mrgrnk和R_mrgrnk，并根据它们的命名，您可能希望这样做的方式是D__mrgrnk一个双精度的实数类型，而R_mrgrnk采用单精度的实数。

通用程序参考

1 个答案: