Intel® oneAPI Math Kernel Library
Ask questions and share information with other developers who use Intel® Math Kernel Library.
6956 Discussions

MKL ERROR: Parameter 2 was incorrect on entry to vdRngUniform

xiaomingg
Beginner
1,637 Views
Hi,

I try to change a fortran 77 program using IMSL to a fortran 90 program using MKL. I got the error message:

MKL ERROR: Parameter 2 was incorrect on entry to vdRngUniform.

I don't know what does it mean. How to fix the problem. Thank you.

Sherry

My program looks like this:


INCLUDE 'mkl_vsl.fi'
PROGRAM MYPROG
USE LINK
USE MKL_VSL
USE MKL_VSL_TYPE
USE F95_PRECISION
USE BLAS95
USE LAPACK95
IMPLICIT INTEGER*4 (I-N), REAL(8) (A-H,O-Z)
INTEGER, PARAMETER:: ISEED=123
...
...
!*****************************************************************************
! RANDOM GENERATOR
!*****************************************************************************
TYPE (VSL_STREAM_STATE) :: STREAM
INTEGER :: BRNG, METHOD, STATUS = 0, INFO = 0
integer(kind=4) ERRCODE
!-----------------------------------------------------------------------------
! INITIALIZE FOR RANDOM SAMPLING
!-----------------------------------------------------------------------------
BRNG = VSL_BRNG_MCG59
ERRCODE=VSLNEWSTREAM( STREAM, BRNG, ISEED )
IF (ERRCODE /= VSL_ERROR_OK) THEN
PRINT *, 'CREATING RANDOM STREAM ERROR: ', ERRCODE
ENDIF

DO 30 I1=1,M
CALL CALC(I,....)
30 continue
...
...
STOP
END PROGRAM MYPROG


SUBROUTINE CALC(I,....)
...
...
IMPLICIT INTEGER*4 (I-N), REAL(8) (A-H,O-Z)
!*****************************************************************************
! RANDOM GENERATOR
!*****************************************************************************
! TYPE (VSL_STREAM_STATE) :: STREAM
! INTEGER :: BRNG, METHOD, STATUS = 0, INFO = 0
! integer(kind=4) ERRCODE

METHOD = VSL_METHOD_DUNIFORM_STD
STATUS = VDRNGUNIFORM( METHOD, STREAM, 100, R, 0, 1.0 )

IF (STATUS /= VSL_ERROR_OK) THEN
PRINT *, 'GENERATING ERROR FOR X: ', STATUS
ENDIF
....
....
....
RETURN
END
0 Kudos
1 Solution
Andrey_N_Intel
Employee
1,637 Views
Hello Sherry,

I developed a short test case that demonstrates use of Intel MKL generators in the application that does random number generation inthe subroutine. I tried to reproduce your code as much as possible. The test case, whichis built using Intel Fortran compiler, runs and printsrandom numbers obtained as result of call to Intel MKL Uniform RNG. Please, let me know if this helps to resolve the compilation and runissues on your side.

Thanks,
Andrey

INCLUDE 'mkl_vsl.fi'

PROGRAM MYPROG

USE MKL_VSL

USE MKL_VSL_TYPE

INTEGER, PARAMETER:: ISEED=123

TYPE (VSL_STREAM_STATE) :: STREAM

INTEGER :: BRNG, METHOD, STATUS = 0, INFO = 0

integer(kind=4) ERRCODE

INTERFACE

SUBROUTINE CALC(I, STREAM)

USE MKL_VSL

USE MKL_VSL_TYPE

INTEGER I

TYPE (VSL_STREAM_STATE) :: STREAM

END SUBROUTINE

END INTERFACE

BRNG = VSL_BRNG_MCG59

ERRCODE=VSLNEWSTREAM( STREAM, BRNG, ISEED )

IF (ERRCODE /= VSL_ERROR_OK) THEN

PRINT *, 'CREATING RANDOM STREAM ERROR: ', ERRCODE

ENDIF

CALL CALC(1, STREAM)

ERRCODE=VSLDELETESTREAM( STREAM )

IF (ERRCODE /= VSL_ERROR_OK) THEN

PRINT *, 'DELETING RANDOM STREAM ERROR: ', ERRCODE

ENDIF

STOP

END PROGRAM MYPROG

SUBROUTINE CALC(I, STREAM)

USE MKL_VSL

USE MKL_VSL_TYPE

INTEGER I

TYPE (VSL_STREAM_STATE) :: STREAM

REAL(KIND=8) R(100)

INTEGER METHOD

INTEGER(KIND=4) STATUS

INTEGER J

METHOD = VSL_RNG_METHOD_UNIFORM_STD

STATUS = VDRNGUNIFORM( METHOD, STREAM, 100, R, 0.0D0, 1.0D0 )

IF (STATUS /= VSL_ERROR_OK) THEN

PRINT *, 'GENERATING ERROR FOR X: ', STATUS

ENDIF

DO J=1,100

PRINT *, R(J)

END DO

RETURN

END

View solution in original post

0 Kudos
11 Replies
mecej4
Honored Contributor III
1,637 Views
Why did you make the TYPE and other declarations inoperative in your subroutine by making them comment lines, causing STREAM to become REAL, etc., because of the implicit typing?
0 Kudos
xiaomingg
Beginner
1,637 Views
Quoting mecej4
Why did you make the TYPE and other declarations inoperative in your subroutine by making them comment lines, causing STREAM to become REAL, etc., because of the implicit typing?

If I don't comment them out, I get error message when I compile.

error #6633: The type of the actual argument differs from the type of the dummy argument. [STREAM]
ERRCODE=VSLNEWSTREAM( STREAM, BRNG, ISEED )
------------------------------^
patterncnty1_2.f90(272): error #6633: The type of the actual argument differs from the type of the dummy argument. [BRNG]
ERRCODE=VSLNEWSTREAM( STREAM, BRNG, ISEED )
--------------------------------------^
patterncnty1_2.f90(1077): error #6457: This derived type name has not been declared. [VSL_STREAM_STATE]
TYPE (VSL_STREAM_STATE) :: STREAM

0 Kudos
Gennady_F_Intel
Moderator
1,637 Views
why don't you use the existing examples? see - \examples\vslf\sources\vdrnguniform.f.
0 Kudos
mecej4
Honored Contributor III
1,637 Views
> If I don't comment them out, I get error message when I compile.

Killing the messenger does not prevent bad things from happening. By relying incorrectly on implicit typing, you promoted the compile time errors to run time aborts.
0 Kudos
xiaomingg
Beginner
1,637 Views
Yes, I try to follow the example. The example has everything in one program. My program has a few subroutines. I have to sample uniform, binomial, normal in my subroutine.

0 Kudos
xiaomingg
Beginner
1,637 Views
Yes, you are absolutely right.

I use IMPLICIT NONE now, but I still get the following compile time errors. I don't know what the error messages mean.

Can anyone please help? Thank you very much.

error #6457: This derived type name has not been declared. [VSL_STREAM_STATE]
TYPE (VSL_STREAM_STATE) :: STREAM
------------^
error #6404: This name does not have a type, and must have an explicit type. [VSL_METHOD_DUNIFORM_STD]
METHOD = VSL_METHOD_DUNIFORM_STD
-----------------^
error #6404: This name does not have a type, and must have an explicit type. [VDRNGUNIFORM]
STATUS = VDRNGUNIFORM( METHOD, STREAM, II, OMEGA, a, b )
-----------------^
error #6404: This name does not have a type, and must have an explicit type. [VSL_ERROR_OK]
IF (STATUS /= VSL_ERROR_OK) THEN
----------------------^
compilation aborted for patterncnty1_2.f90 (code 1)

0 Kudos
TimP
Honored Contributor III
1,637 Views
If you have have both the f77 vsl include file and the f90 USE, as you showed at the top, that may account for the error.
0 Kudos
Andrey_N_Intel
Employee
1,638 Views
Hello Sherry,

I developed a short test case that demonstrates use of Intel MKL generators in the application that does random number generation inthe subroutine. I tried to reproduce your code as much as possible. The test case, whichis built using Intel Fortran compiler, runs and printsrandom numbers obtained as result of call to Intel MKL Uniform RNG. Please, let me know if this helps to resolve the compilation and runissues on your side.

Thanks,
Andrey

INCLUDE 'mkl_vsl.fi'

PROGRAM MYPROG

USE MKL_VSL

USE MKL_VSL_TYPE

INTEGER, PARAMETER:: ISEED=123

TYPE (VSL_STREAM_STATE) :: STREAM

INTEGER :: BRNG, METHOD, STATUS = 0, INFO = 0

integer(kind=4) ERRCODE

INTERFACE

SUBROUTINE CALC(I, STREAM)

USE MKL_VSL

USE MKL_VSL_TYPE

INTEGER I

TYPE (VSL_STREAM_STATE) :: STREAM

END SUBROUTINE

END INTERFACE

BRNG = VSL_BRNG_MCG59

ERRCODE=VSLNEWSTREAM( STREAM, BRNG, ISEED )

IF (ERRCODE /= VSL_ERROR_OK) THEN

PRINT *, 'CREATING RANDOM STREAM ERROR: ', ERRCODE

ENDIF

CALL CALC(1, STREAM)

ERRCODE=VSLDELETESTREAM( STREAM )

IF (ERRCODE /= VSL_ERROR_OK) THEN

PRINT *, 'DELETING RANDOM STREAM ERROR: ', ERRCODE

ENDIF

STOP

END PROGRAM MYPROG

SUBROUTINE CALC(I, STREAM)

USE MKL_VSL

USE MKL_VSL_TYPE

INTEGER I

TYPE (VSL_STREAM_STATE) :: STREAM

REAL(KIND=8) R(100)

INTEGER METHOD

INTEGER(KIND=4) STATUS

INTEGER J

METHOD = VSL_RNG_METHOD_UNIFORM_STD

STATUS = VDRNGUNIFORM( METHOD, STREAM, 100, R, 0.0D0, 1.0D0 )

IF (STATUS /= VSL_ERROR_OK) THEN

PRINT *, 'GENERATING ERROR FOR X: ', STATUS

ENDIF

DO J=1,100

PRINT *, R(J)

END DO

RETURN

END

0 Kudos
xiaomingg
Beginner
1,637 Views
Hi Andrey,

Thank you for your example. It works fine. I guess I need the interface block in my code. If I have main program calls subroutine A, and subroutine A calls subroutine B. I need interface block in subroutine A before calling subroutine B, am I right?

Sherry
0 Kudos
mecej4
Honored Contributor III
1,637 Views
An interface block is one method for providing a required explicit interface to a routine.

Another method is to declare the called or referenced routines in a module and, in the caller(s), USE that module.

The Fortran reference manual should be consulted regarding circumstances in which an explicit interface is obligatory.
0 Kudos
Andrey_N_Intel
Employee
1,637 Views
Hi Sherry,

As Mecej4 mentioned in his post,please chooseone of the approaches for the explicit interface specification that would workin your app:either interface statement (as in the example above), ora module based scheme (please, have a look atmkl_vsl.f90 fileas one possible example).

Thanks,
Andrey
0 Kudos
Reply