Справочник по общей процедуре

Я пытаюсь скомпилировать фортран-модуль 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

МОДУЛЬ 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

fortran fortran90 intel-fortran

Shejo284 17.06.2014 источник

comment

Сообщение об ошибке довольно явное и говорит вам, где именно в вашем исходном файле возникает проблема. Вы определили 2 подпрограммы с одинаковой сигнатурой. Но как вы ожидаете большей помощи, чем эта, не показывая свой код? - High Performance Mark 18.06.2014

comment

Извинения. Я добавил код сейчас. - Shejo284 18.06.2014

comment

Можете ли вы опубликовать блок интерфейса для mrgrnk в модуле m_mrgrnk? - casey 18.06.2014

Ответы (1)

arrow_upward
4
arrow_downward

Здесь есть проблемы:

Конкретные интерфейсы с вашим общим интерфейсом должны быть уникальными (тип/ранг/и т.д. не должны совпадать).

В частности, происходит то, что процедуры вашего модуля не кажутся отдельными, поэтому, когда вы:

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 принимал реальный тип. это одинарная точность.

casey 17.06.2014

comment

Я немного новичок, когда дело доходит до этих более тонких ошибок. Этот код был переведен с F77 на Fortran 90. Вы говорите, что в модуле я не могу определить функцию и подпрограмму? - Shejo284; 18.06.2014

comment

@ Shejo284, ты, конечно, можешь это сделать. Предоставленная вами ошибка не жалуется на это, она жалуется на то, что у вас есть общий блок interface, в котором объявлены два конкретных интерфейса, которые не являются уникальными. Вы можете иметь в модуле любые процедуры и функции, которые вы хотите, но в универсальном интерфейсе существуют более строгие правила. Ошибка не в коде, который вы разместили, скорее всего, в модуле m_mrgnk. - casey; 18.06.2014

comment

Вот часть модуля, в котором определен интерфейс mrgrnk(): СОДЕРЖИТ отрывок.... Модуль m_mrgrnk слишком длинный, чтобы размещать его здесь, и я не знаю, как прикрепить сюда файл. Я просмотрел эти файлы. Я не писал файл, я только пытаюсь обновить их до F90 и исправить любые ошибки. Все подпрограммы в m_mrgrnk определены с разными именами. - Shejo284; 18.06.2014

comment

@ Shejo284 Shejo284, можете ли вы отредактировать это в своем Q вместе с интерфейсами для D_mrgrnk, R_mrgrnk, I_mrgrnk? Ваш компилятор жалуется, что эти три не различны, поэтому, чтобы помочь, нам нужно увидеть, каковы аргументы для каждого. - casey; 18.06.2014

comment

MODULE m_mrgrnk USE PARKIND1 ,ONLY : JPIM, JPIB, JPRB PUBLIC :: mrgrnk 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) END SUBROUTINE D_mrgrnk SUBROUTINE R_mrgrnk ( XDONT, IRNGT) КОНЕЦ ПОДПРОГРАММЫ R_mrgrnk ПОДПРОГРАММА I_mrgrnk (XDONT, IRNGT) КОНЕЦ ПОДПРОГРАММЫ I_mrgrnk КОНЕЦ МОДУЛЯ m_mrgrnk - Shejo284; 18.06.2014

comment

@ Shejo284 Shejo284 это значительно повысило бы читабельность, если бы вы могли поместить это в свой вопрос, а не в эти комментарии. Кроме того, это полные подпрограммы или также объявлены такие переменные, как XDONT, IRNGT? Как минимум, когда вы редактируете свой вопрос, добавьте приведенную выше информацию, включая способ объявления этих аргументов. - casey; 18.06.2014

comment

Хорошо, извиняюсь за неуклюжий способ, которым я это сделал. Теперь оба полных модуля размещены в Q. Включены все объявления для аргументов. - Shejo284; 18.06.2014

comment

А... теперь я понимаю. Странно вызывать функцию, основанную на точности аргумента. Я новичок в фортране и никогда раньше не сталкивался с чем-то подобным. Ошибка закралась, когда я попытался сделать весь код одного вида реальным и добрым целым числом. Я благодарен за помощь! - Shejo284; 18.06.2014

Справочник по общей процедуре

Ответы (1)

Похожие вопросы