- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I am trying to pass a 2-dimensional array (double/real*8) from C to Fortran. See code below. (I've also been trying to pass integers and strings which I've had some help with in earlier posts). I am using the "Fortran_Calls_C" examples from the IVF 11.0 example files to figure out how to do this. Some notes:
1) I've been trying a couple of different ways, including passing through the call statement but right now I'm trying a "global" type solution using Fortran common and C struct statements. There seems to be a fair amount of info out in "google-land" concerning this; I just can't get the examples I find to work. I realize that using Fortran common is on the "way out" but getting something to work right now is of paramount importance. I plan on updating/modernizing my Fortran skills in the future.
2) The C code I'm "stuck" with reads data that's in a proprietary format; there is no Fortran version. I've checked with the company. I can run this C code as a main program without problems (this is the first time I've worked with C/C++; and my Fortran skills are rather primitive and outdated also but I am slowly making progress). I can compile the C code as a dll and call it from a Fortran main. I've also done this with the Fortran/C examples given in the IVF 11.0 example folder mentioned above and which I will insert in this post below.
3) I've been able to pass integers (with help from this forum) and am working on strings but I'm still bedeviled with arrays. I can debug from the C dll and see that the array is filling okay on the C side, but I cannot get anything to show up on the Fortran side; not even junk. Always zeros.
4) I plan on posing this queston on a couple of C/C++ forums as well (including perhaps the Intel one and the MSDN one. Note: I did post once on a MSDN C related forum concerning a Fortran/C interfacing issue and they told me about this nice forum which I was already well aware of naturally having had a Fortran background :) )
5) I've tried to make this as simple as possible by using the examples in the IVF 11.0 documentation and making as few modications as necessary, (when I get this to work) I'll then try and implement in the C application code). I've inserted the modifed IVF 11.0 example code below and have inserted the comment "!MJB" or "//MJB" ("MJB" is simply my initials) at the end of the lines that I have modified.
I can run the code below without errors (VS 2005 SP1/Vista, IVF 11.0), I just can't get the Fortran array to see the contents (apparently) of the C array.
My previous post, concerning primarily strings/integers can be found here:
http://software.intel.com/en-us/forums/showthread.php?t=62464
The Fortran modified example:
[cpp]! Copyright (C) 2008 Intel Corporation. All Rights Reserved.
!
! The source code contained or described herein and all documents related to the source code
! ("Material") are owned by Intel Corporation or its suppliers or licensors. Title to the
! Material remains with Intel Corporation or its suppliers and licensors. The Material is
! protected by worldwide copyright laws and treaty provisions. No part of the Material may be
! used, copied, reproduced, modified, published, uploaded, posted, transmitted, distributed,
! or disclosed in any way except as expressly provided in the license provided with the
! Materials. No license under any patent, copyright, trade secret or other intellectual
! property right is granted to or conferred upon you by disclosure or delivery of the
! Materials, either expressly, by implication, inducement, estoppel or otherwise, except as
! expressly provided in the license provided with the Materials.
PROGRAM READDATAFILE !MJB
IMPLICIT NONE
! This is an example of a Fortran main program calling
! a C routine. It uses the C Interoperability features
! of Fortran 2003
! Declare the interface for the C routine we'll call
!
INTERFACE
! The BIND(C) tells the compiler that this is an "interoperable"
! procedure. The compiler adjusts the naming conventions as
! appropriate for the companion C processor.
SUBROUTINE c_routine (int_arg, str_in, str_out) BIND(C)
USE,INTRINSIC :: ISO_C_BINDING ! Declares C kinds
! First argument is a C "int", passed by value
c INTEGER(C_INT), VALUE,INTENT(IN) :: int_arg
! Second and third arguments are C "char *", represented
! in Fortran by an array of single characters of kind C_CHAR.
! Note that the language allows passing a regular CHARACTER
! variable to such an argument.
CHARACTER(KIND=C_CHAR),DIMENSION(*) :: str_in,str_out
REAL(Kind=C_Double),Dimension(3:2) :: datastuff !MJB
bind(c,name='datastuff')::/datastuff/ !MJB
!probably not necessary since everything's lowercase but
!left in just in case
END SUBROUTINE c_routine
END INTERFACE
CHARACTER(80) OUTPUT_TEXT
INTEGER IN_ARG, OUTPUT_LEN
CHARACTER(80) INPUT_TEXT
real*8 datastuff !MJB
COMMON /mystuff/datastuff(3,2) !MJB
c INPUT_TEXT = "Testing..."C ! C suffix adds a null terminator !MJB
IN_ARG = 123
! Call c_routine. It will return text in OUTPUT_TEXT
!
CALL c_routine (in_arg, input_text, output_text)
! Find the length of the output text, looking
! for the trailing blank
!
c OUTPUT_LEN = INDEX(OUTPUT_TEXT," ") !MJB
c IF (OUTPUT_LEN == 0) OUTPUT_LEN = 80 !MJB
! Write the string to the console
!
c WRITE (*,*) OUTPUT_TEXT(1:OUTPUT_LEN) !MJB
END[/cpp]
Note: If there is no "!MJB" appended onto a line, the code is very likely not mine and is original code from the examples in the "Fortran_Calls_C" folder in the IVF 11.0 Examples folder. (There is a possibility of course that I missed appending a line that I changed/added). (Note: The line that contains " "Testing..."C " is original; I just commented it out.)
The C modified example code: (I am using a ".c" extension, not ".cpp")
[cpp]/*
! Copyright (C) 2008 Intel Corporation. All Rights Reserved.
!
! The source code contained or described herein and all documents related to the source code
! ("Material") are owned by Intel Corporation or its suppliers or licensors. Title to the
! Material remains with Intel Corporation or its suppliers and licensors. The Material is
! protected by worldwide copyright laws and treaty provisions. No part of the Material may be
! used, copied, reproduced, modified, published, uploaded, posted, transmitted, distributed,
! or disclosed in any way except as expressly provided in the license provided with the
! Materials. No license under any patent, copyright, trade secret or other intellectual
! property right is granted to or conferred upon you by disclosure or delivery of the
! Materials, either expressly, by implication, inducement, estoppel or otherwise, except as
! expressly provided in the license provided with the Materials.
*/
/* C routine called by Fortran main program
**
** Converts integer input argument to text, appends
** the text to string input argument and stores the
** result in the string output argument
*/
#include
#define DllExport __declspec( dllexport ) //MJB
__declspec( dllexport ) void c_routine(); //MJB
#define cols 2 //MJB
#define rows 3 //MJB
extern struct{double *datastuff[2][3];} mystuff; //MJB
extern void c_routine ( //MJB: took out the ""C""
int int_arg,
char* input_text,
char* output_text
)
{
double datastuff[cols][rows]={3.0,4.0,5.0,6.0,7.0,8.0};
// sprintf(output_text,"%s%i ",input_text,int_arg); //MJB
}
[/cpp]
Thanks much.
Mike
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Mike,
I think you need to remove "double*" from inside c_routine. This will cause (enable)c_routine to store into the external named block (presumably in the FORTRAN COMMON).
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Mike,
I think you need to remove "double*" from inside c_routine. This will cause (enable)c_routine to store into the external named block (presumably in the FORTRAN COMMON).
Jim Dempsey
Jim,
Nope. I've tried with and without the asterisk (keeping "double") and everything builds and runs but nothing shows up either way on the Fortran side.
I tried removing both "double" and "*" leaving:
extern struct{datastuff[2][3];} mystuff;
and get the following when I try to build:
"error C2016: C requires that a struct or union has a least one member
error C2061: syntax error: identifier 'datastuff' [I get " error C2059: syntax error:'*'" in place of this one if I doput an "*" only in front of "datastuff"]
error C2059: syntax error:'}'"
Mike
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I belive you will find
externdouble*datastuff[2][3];//MJB
will work better (datstuff is name in Fortran common)
You may have a problem with casing and prepending or not of _
Look in the chapter on mixed language requrements to learn how to get the naming convention right.
When all else fails, produce the ASM output for both the F90 and .CPP files and check the generated names.
Jim
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I belive you will find
externdouble*datastuff[2][3];//MJB
will work better (datstuff is name in Fortran common)
You may have a problem with casing and prepending or not of _
Look in the chapter on mixed language requrements to learn how to get the naming convention right.
When all else fails, produce the ASM output for both the F90 and .CPP files and check the generated names.
Jim
Okay,first time I've produced ASM out. I managed to find the options in IDE and came up with the following files. I've highlighted a line in each that corresponds to "MYSTUFF" in the Fortran one and "datastuff" in the C one.
I don't understand why you had me take out the "mystuff" reference on the C side. That seemed to make sense; to have the same name referenced on both sides.I am aware there are prepending underscore issues and I think I may have played with that a time or two along with a thousand other "darts".
I'm not sure what to make of the listings below. What I would kind of expect to find is perhaps MYSTUFF listed incaps in one file and listed in all lower case in the other and/or perhaps one file has an "_" in the name and the other one does not. I don't see that here.
Mike
Fortran .asm output
[cpp]; -- Machine type IA32 ; mark_description "Intel Fortran Compiler for applications running on IA-32, Version 10.1 Build 20070913 %s"; ; mark_description "-Qvc8 -Qlocation,link,C:Program FilesMicrosoft Visual Studio 8VCBin -nologo -debug:full -Od -gen-int"; ; mark_description "erfaces -warn:interfaces -module:Debug -object:Debug -asmattr:source -asmfile:Debug -traceback -check:"; ; mark_description "bounds -libs:static -threads -dbglibs -c -Qvc8 -Qlocation,link,C:Program FilesMicrosoft Visual Studio 8"; ; mark_description "VCbin"; .486P .387 OPTION DOTNAME ASSUME CS:FLAT,DS:FLAT,SS:FLAT _DATA SEGMENT DWORD PUBLIC FLAT 'DATA' _DATA ENDS _TEXT SEGMENT DWORD PUBLIC FLAT 'CODE' TXTST0: ; -- Begin _MAIN__ ; mark_begin; IF @Version GE 800 .MMX ELSEIF @Version GE 612 .MMX MMWORD TEXTEQUENDIF IF @Version GE 800 .XMM ELSEIF @Version GE 614 .XMM XMMWORD TEXTEQU ENDIF ALIGN 2 PUBLIC _MAIN__ _MAIN__ PROC NEAR $B1$1: ; Preds $B1$0 ;;; PROGRAM READDATAFILE !MJB $LN1: push ebp ;14.15 mov ebp, esp ;14.15 sub esp, 3 ;14.15 and esp, -8 ;14.15 add esp, 4 ;14.15 push esi ;14.15 push edi ;14.15 mov DWORD PTR [esp], OFFSET FLAT: LITPACK_0 ;14.15 call _for_set_reentrancy ;14.15 ; LOE $B1$6: ; Preds $B1$1 pop ecx ;14.15 ; LOE $B1$2: ; Preds $B1$6 $LN3: ;;; IMPLICIT NONE ;;; ;;; ! This is an example of a Fortran main program calling ;;; ! a C routine. It uses the C Interoperability features ;;; ! of Fortran 2003 ;;; ;;; ! Declare the interface for the C routine we'll call ;;; ! ;;; INTERFACE ;;; ! The BIND(C) tells the compiler that this is an "interoperable" ;;; ! procedure. The compiler adjusts the naming conventions as ;;; ! appropriate for the companion C processor. ;;; SUBROUTINE c_routine (int_arg, str_in, str_out) BIND(C) ;;; USE,INTRINSIC :: ISO_C_BINDING ! Declares C kinds ;;; ;;; ! First argument is a C "int", passed by value ;;; c INTEGER(C_INT), VALUE,INTENT(IN) :: int_arg ;;; ! Second and third arguments are C "char *", represented ;;; ! in Fortran by an array of single characters of kind C_CHAR. ;;; ! Note that the language allows passing a regular CHARACTER ;;; ! variable to such an argument. ;;; CHARACTER(KIND=C_CHAR),DIMENSION(*) :: str_in,str_out ;;; ;;; REAL(Kind=C_Double),Dimension(3:2) :: datastuff !MJB ;;; bind(c,name='datastuff')::/datastuff/ !MJB ;;; !probably not necessary since everything's lowercase but ;;; !left in just in case ;;; ;;; END SUBROUTINE c_routine ;;; END INTERFACE ;;; ;;; CHARACTER(80) OUTPUT_TEXT ;;; INTEGER IN_ARG, OUTPUT_LEN ;;; CHARACTER(80) INPUT_TEXT ;;; real*8 datastuff !MJB ;;; COMMON /mystuff/datastuff(3,2) !MJB ;;; ;;; c INPUT_TEXT = "Testing..."C ! C suffix adds a null terminator !MJB Original line from code I just commented it out ;;; IN_ARG = 123 mov DWORD PTR [ebp-4], 123 ;53.7 $LN5: ;;; ;;; ! Call c_routine. It will return text in OUTPUT_TEXT ;;; ! ;;; CALL c_routine (in_arg, input_text, output_text) add esp, -20 ;57.12 lea eax, DWORD PTR [ebp-4] ;57.12 mov DWORD PTR [esp], eax ;57.12 mov DWORD PTR [esp+4], OFFSET FLAT: READDATAFILE$INPUT_TEXT ;57.12 mov DWORD PTR [esp+8], OFFSET FLAT: READDATAFILE$OUTPUT_TEXT ;57.12 mov eax, 80 ;57.12 mov DWORD PTR [esp+12], eax ;57.12 mov DWORD PTR [esp+16], eax ;57.12 call _c_routine ;57.12 ; LOE $B1$7: ; Preds $B1$2 add esp, 20 ;57.12 ; LOE $B1$3: ; Preds $B1$7 $LN7: ;;; ;;; ! Find the length of the output text, looking ;;; ! for the trailing blank ;;; ! ;;; c OUTPUT_LEN = INDEX(OUTPUT_TEXT," ") !MJB ;;; c IF (OUTPUT_LEN == 0) OUTPUT_LEN = 80 !MJB ;;; ;;; ! Write the string to the console ;;; ! ;;; c WRITE (*,*) OUTPUT_TEXT(1:OUTPUT_LEN) !MJB ;;; ;;; END mov eax, 1 ;69.7 leave ;69.7 ret ;69.7 ALIGN 2 ; LOE ; mark_end; _MAIN__ ENDP .LN_MAIN__: _TEXT ENDS _BSS SEGMENT DWORD PUBLIC FLAT 'BSS' READDATAFILE$OUTPUT_TEXT DB ? ; pad ORG $+78 ; pad DB ? ; pad DD 4 DUP (?) ; pad READDATAFILE$INPUT_TEXT DB ? ; pad ORG $+78 ; pad DB ? ; pad _BSS ENDS _RDATA SEGMENT DWORD PUBLIC FLAT 'DATA' LITPACK_0 DD 2 _RDATA ENDS _DATA SEGMENT DWORD PUBLIC FLAT 'DATA' _DATA ENDS ; -- End _MAIN__ _RDATA SEGMENT DWORD PUBLIC FLAT 'DATA' STRLITPACK_0 DB 95 DB 99 DB 95 DB 114 DB 111 DB 117 DB 116 DB 105 DB 110 DB 101 DB 0 DB 1 DUP (0) ; pad STRLITPACK_1 DB 100 DB 97 DB 116 DB 97 DB 115 DB 116 DB 117 DB 102 DB 102 DB 0 _RDATA ENDS _DATA SEGMENT DWORD PUBLIC FLAT 'DATA' COMM _MYSTUFF:BYTE:48 _DATA ENDS EXTRN _for_set_reentrancy:PROC EXTRN _c_routine:PROC END [/cpp]
[cpp]C .asm output[/cpp]
[cpp]; Listing generated by Microsoft Optimizing Compiler Version 14.00.50727.762 TITLE c:FCArrayCsub.c .686P .XMM include listing.inc .model flat INCLUDELIB MSVCRTD INCLUDELIB OLDNAMES PUBLIC __real@4020000000000000 PUBLIC __real@401c000000000000 PUBLIC __real@4018000000000000 PUBLIC __real@4014000000000000 PUBLIC __real@4010000000000000 PUBLIC __real@4008000000000000 PUBLIC _c_routine EXTRN __fltused:DWORD EXTRN @_RTC_CheckStackVars@8:PROC EXTRN __RTC_Shutdown:PROC EXTRN __RTC_InitBase:PROC ; COMDAT __real@4020000000000000 ; File c:fcarraycsub.c CONST SEGMENT __real@4020000000000000 DQ 04020000000000000r ; 8 CONST ENDS ; COMDAT __real@401c000000000000 CONST SEGMENT __real@401c000000000000 DQ 0401c000000000000r ; 7 CONST ENDS ; COMDAT __real@4018000000000000 CONST SEGMENT __real@4018000000000000 DQ 04018000000000000r ; 6 CONST ENDS ; COMDAT __real@4014000000000000 CONST SEGMENT __real@4014000000000000 DQ 04014000000000000r ; 5 CONST ENDS ; COMDAT __real@4010000000000000 CONST SEGMENT __real@4010000000000000 DQ 04010000000000000r ; 4 CONST ENDS ; COMDAT __real@4008000000000000 CONST SEGMENT __real@4008000000000000 DQ 04008000000000000r ; 3 CONST ENDS ; COMDAT rtc$TMZ rtc$TMZ SEGMENT __RTC_Shutdown.rtc$TMZ DD FLAT:__RTC_Shutdown rtc$TMZ ENDS ; COMDAT rtc$IMZ rtc$IMZ SEGMENT __RTC_InitBase.rtc$IMZ DD FLAT:__RTC_InitBase ; Function compile flags: /Odtp /RTCsu /ZI rtc$IMZ ENDS ; COMDAT _c_routine _TEXT SEGMENT _datastuff$ = -52 ; size = 48 _int_arg$ = 8 ; size = 4 _input_text$ = 12 ; size = 4 _output_text$ = 16 ; size = 4 _c_routine PROC ; COMDAT ; Line 39 push ebp mov ebp, esp sub esp, 248 ; 000000f8H push ebx push esi push edi lea edi, DWORD PTR [ebp-248] mov ecx, 62 ; 0000003eH mov eax, -858993460 ; ccccccccH rep stosd ; Line 40 fld QWORD PTR __real@4008000000000000 fstp QWORD PTR _datastuff$[ebp] fld QWORD PTR __real@4010000000000000 fstp QWORD PTR _datastuff$[ebp+8] fld QWORD PTR __real@4014000000000000 fstp QWORD PTR _datastuff$[ebp+16] fld QWORD PTR __real@4018000000000000 fstp QWORD PTR _datastuff$[ebp+24] fld QWORD PTR __real@401c000000000000 fstp QWORD PTR _datastuff$[ebp+32] fld QWORD PTR __real@4020000000000000 fstp QWORD PTR _datastuff$[ebp+40] ; Line 43 push edx mov ecx, ebp push eax lea edx, DWORD PTR $LN5@c_routine call @_RTC_CheckStackVars@8 pop eax pop edx pop edi pop esi pop ebx mov esp, ebp pop ebp ret 0 $LN5@c_routine: DD 1 DD $LN4@c_routine $LN4@c_routine: DD -52 ; ffffffccH DD 48 ; 00000030H DD $LN3@c_routine $LN3@c_routine: DB 100 ; 00000064H DB 97 ; 00000061H DB 116 ; 00000074H DB 97 ; 00000061H DB 115 ; 00000073H DB 116 ; 00000074H DB 117 ; 00000075H DB 102 ; 00000066H DB 102 ; 00000066H DB 0 _c_routine ENDP _TEXT ENDS END [/cpp]
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Okay, so the bold formatting thing doesn't work in the code area once you post. But now I've got the line numbers to work with.
In the Fortran .asm output, line number 178 contains "mystuff" and in the C .asm output line 59 contains "datastuff"
Mike
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Attached (hopefully) files show a couple of ways of throwing rank two arrays from Fortran to C, including as function arguments, common block members and module variables. I think they all ok (hopefully), but this is me learning as opposed to something normative. If others see problems then please let me know.
The files also touch on memory ownership issues - ie Fortran vs C - with an example that allocates memory using the C library malloc and then passes a pointer back for the Fortran code to play with. When the Fortran has finished playing it has to let the C code know so the toys can be put away in the right place. Other example bits are based around Fortran code "owning" the storage for the interoperable variables.
This particular set uses static linking (compile the c code to a static library (lib) and link the fortran to it) rather than the dynamic linking implied by some of your code. The static linking may be required for the common block and module variable cases (can an EXE export things for a DLL to bind to at run time??), it avoids all that __declspec business and should be cross-platform compilable.
Aside for Intel folk - under IVF 11.0.066 I get error #8067 complaining that I'm doing BIND(C) :: zzz outside of the specification section of a module, when zzz is an entity-name. In the particular case zzz was actually a common-block-name and I don't read R550 as prohibiting that.
From a quick look at the OP's extended example (in the other thread) I think I saw confusion about variable scope on the C side. That is akin to declaring a fortran variable locally inside one procedure and then expecting that another variable with the same name declared inside a different procedure to have the same storage. I think you are well into the domain of learning more about C, than about Fortran-C operability per se.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Error #8067 goes away if I use BIND(C) :: / common-block-name /, which is what the syntax should be - my bad.
And its a constraint C550, not R550.
Why don't I get some sort of error for leaving the '/'s out in the BIND(C):: statment that is in a module?
Thanks,
IanH
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Now I can start to see some things that obviously hidden in your source code.
You declare an INTERFACE for c_routine, which is OK in of itself
However, inside the interface, you are declaring local variables
which amount to doing nothing. The declarations inside the
interface (doing nothing) are attempting to declar the linkage for "datastuff".
Outside the interface block you have
real*8 datastuff !MJB
COMMON /mystuff/datastuff(3,2) !MJB
Which is declaring an external linkage named "mystuff" as opposed to "datastuff"
The Fortran code is declaring "COMM _MYSTUFF" (COMM might come off)
The C code is expecting "_datastuff$"
Try moving the BIND outside of the scope of the interface block
perhaps next to the COMMON
Note, use of module might clean things up.
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Now I can start to see some things that obviously hidden in your source code.
You declare an INTERFACE for c_routine, which is OK in of itself
However, inside the interface, you are declaring local variables
which amount to doing nothing. The declarations inside the
interface (doing nothing) are attempting to declar the linkage for "datastuff".
Outside the interface block you have
real*8 datastuff !MJB
COMMON /mystuff/datastuff(3,2) !MJB
Which is declaring an external linkage named "mystuff" as opposed to "datastuff"
The Fortran code is declaring "COMM _MYSTUFF" (COMM might come off)
The C code is expecting "_datastuff$"
Try moving the BIND outside of the scope of the interface block
perhaps next to the COMMON
Note, use of module might clean things up.
Jim Dempsey
Okay, here's my first attempt at using a module, which I'm lead to believe is what I should be working towards learning if I want to share data between C/C++ and Fortran. Still get all zeros on the Fortran side. I also got rid of the common statement (which I've read is also encouraged these days) hoping that the "COMM might come off". It didn't.
However, instead of "COMM_MYSTUFF" I get "COMM _SEEDATA_mp_DATASTUFF:BYTE:48" in the Fortran .asm.
Still get "_datastuff$ = -52 ; size = 48" on the C .asm side.
(What's the "$" sign appedned on "_datastuff" for/mean?)
Mike
The latest Fortran Source:
[cpp]! Copyright (C) 2008 Intel Corporation. All Rights Reserved.
!
Module seedata
IMPLICIT NONE
SAVE
c REAL*8,Dimension(3:2) :: datastuff(3,2)
REAL*8 datastuff(3,2)
c COMMON /datastuff/datastuff
End Module seedata
PROGRAM READDATAFILE !MJB
USE seedata
IMPLICIT NONE
! This is an example of a Fortran main program calling
! a C routine. It uses the C Interoperability features
! of Fortran 2003
! Declare the interface for the C routine we'll call
!
INTERFACE
! The BIND(C) tells the compiler that this is an "interoperable"
! procedure. The compiler adjusts the naming conventions as
! appropriate for the companion C processor.
SUBROUTINE c_routine (int_arg, str_in, str_out) BIND(C)
USE,INTRINSIC :: ISO_C_BINDING ! Declares C kinds
! First argument is a C "int", passed by value
c INTEGER(C_INT), VALUE,INTENT(IN) :: int_arg
! Second and third arguments are C "char *", represented
! in Fortran by an array of single characters of kind C_CHAR.
! Note that the language allows passing a regular CHARACTER
! variable to such an argument.
CHARACTER(KIND=C_CHAR),DIMENSION(*) :: str_in,str_out
c REAL(Kind=C_Double),Dimension(3:2) :: datastuff !MJB
!probably not necessary since everything's lowercase but
!left in just in case
END SUBROUTINE c_routine
END INTERFACE
CHARACTER(80) OUTPUT_TEXT
INTEGER IN_ARG, OUTPUT_LEN
CHARACTER(80) INPUT_TEXT
c real*8 datastuff(3,2) !MJB
c COMMON /datastuff/datastuff(3,2) !MJB
bind(c,name='_datastuff')::/datastuff/ !MJB
c INPUT_TEXT = "Testing..."C ! C suffix adds a null terminator !MJB Original line from code I just commented it out
IN_ARG = 123
! Call c_routine. It will return text in OUTPUT_TEXT
!
CALL c_routine (in_arg, input_text, output_text)
! Find the length of the output text, looking
! for the trailing blank
!
c OUTPUT_LEN = INDEX(OUTPUT_TEXT," ") !MJB
c IF (OUTPUT_LEN == 0) OUTPUT_LEN = 80 !MJB
! Write the string to the console
!
c WRITE (*,*) OUTPUT_TEXT(1:OUTPUT_LEN) !MJB
END[/cpp]
C source:
[cpp]/* ! Copyright (C) 2008 Intel Corporation. All Rights Reserved. ! */ /* C routine called by Fortran main program ** ** Converts integer input argument to text, appends ** the text to string input argument and stores the ** result in the string output argument */ #include#define DllExport __declspec( dllexport ) //MJB __declspec( dllexport ) void c_routine(); //MJB #define cols 2 //MJB #define rows 3 //MJB extern double *datastuff[2][3]; //MJB extern void c_routine ( //MJB: took out the ""C"" int int_arg, char* input_text, char* output_text ) { double datastuff[cols][rows]={3.0,4.0,5.0,6.0,7.0,8.0}; // sprintf(output_text,"%s%i ",input_text,int_arg); //MJB } [/cpp]
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Simple version. We're inter-operating with a two dimensional array that is a module variable.
[cpp]MODULE seedata
USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
! The data
REAL(C_DOUBLE), BIND(C) :: datastuff(3,2)
INTERFACE
SUBROUTINE c_routine BIND(C)
! No arguments.
! Everything is global.
! Array dimensions are hard coded.
! All very bad.
END SUBROUTINE c_routine
END INTERFACE
CONTAINS
SUBROUTINE print_data
INTEGER i
DO i=1,2
WRITE(*,"(I4,3G12.3)") i, datastuff(:,i)
END DO
END SUBROUTINE print_data
END MODULE seedata
PROGRAM readdatafile
USE seedata
IMPLICIT NONE
CALL c_routine
CALL print_data
END PROGRAM readdatafile[/cpp]
C code.
[cpp]/* A good convention is to use ALL-CAPITALS for preprocessor defines, to avoid
accidentally obliterating something in your code (C being case sensitive).
*/
#define COLS 2
#define ROWS 3
/* Fortran exposes the array, C just links to it, hence the extern to tell
C that this array is actually "allocated" somewhere else (resolved at
link time. */
extern double datastuff[COLS][ROWS];
/* You could declare the C-function separately (as you have been doing) if
you wanted to. But it serves no useful purpose - the declaration is simply
information the compiler would use if your C program itself made a call to
c_routine. It doesn't, it is only called by Fortran. */
/* Definition of our C function. No extern needed (it doesn't make sense
in the context of a C program).
Because this function returns void (ie nothing) it is equivalent to a
fortran subroutine. It also takes no arguments.
If this was a C++ program, you would want to prepend extern "C". This tells
the compiler to not "mangle" the name of the function with type information.
*/
void c_routine(void)
{
int ic, ir; /* column and row counter */
for (ic = 0; ic < COLS; ic ++) {
for (ir = 0; ir < ROWS; ir ++) {
datastuff[ic][ir] = 99.9; /* transfer the values that you want */
}
}
}[/cpp]
I put the C code into its own project in VS2005, make it build a static library. Put the fortran code into its own project, building a boring console executable. I then add the C project as a dependent of the Fortran project, ensure that the run-time libraries used by the two projects are the same (say "debug multithreaded") and that's more or less it.
Some notes on your C code:
- With the * in your first datastuff declaration, you are declaring a two dimensional array of _pointers_ to double (ie an array of memory addresses). You don't want that (unless you are doing a lot of pointing) - you just want an array of doubles. Now under the hood (and with C the hood is often completely missing...) a variable that is an array of doubles is just a *single* pointer to (zero or more) double(s) located whereever in memory they might happen to be.
- You are doubly declaring datastuff, once at file scope (with the unwanted * - see above) and then locally (and differently) within c_routine. The local definition hides the file scope one. As a result, changes made to the local datastuff (within c_routine) have no bearing on the "global" datastuff. It is the global datastuff that is interoperable with Fortran. An simplistic analogy within Fortran is:
PROGRAM global
INTEGER i ! this is a bit like the file scope datastuff
i = 1
CALL local
WRITE(*,*) i ! will print 1
CONTAINS
SUBROUTINE local
INTEGER i ! This declaration hides the i declared above
i = 2
END SUBROUTINE
END PROGRAM global
- The assignment to datastuff in c_routine currently changes (if it weren't a declaration) the pointer held by datastuff, not the data actually pointed to. C and Fortran differ significantly in this regard:
[cpp] REAL arr1(3), arr2(3)
arr1 = ... ! somehow initialise arr1
arr2 = arr1 ! actually copies, element by element, arr1's data to arr2
[/cpp]
[cpp] float arr1[3] = {...}, arr2[3];
// sets aside some memory, puts ... in it, makes arr1 point at it, arr2
// points to a different bit of memory
//arr2 = arr1; // makes arr2 point at arr1's data, but doesn't copy data
for (...) arr2[..] = arr1[..]; // need to copy data explicitly
[/cpp]
This is similar to the assignment of a literal string in your previous post, you needed to use strcpy to copy the string, and not just change the pointer.
This specific example may not be too relevant for interfacing with your labview code. In the above, Fortran allocates the memory for the array (effectively during startup), it therefore has to know the size of the array at compile time and that is not likely to be suitable for a variably sized file.
As the labview example currently does, you may need to consider letting the C-code calculate the size of the memory buffer required, allocate that buffer (using malloc), extract the data into that buffer and then pass/return the address of the buffer back to fortran, which can then associate the buffer with a fortran array. I posted a prototype example of this earlier in amongst the others. Another alternative might be to interface directly from Fortran to the DDC_* routines (BIND(C) to them), and then do the size calculation and allocation work directly in fortran (the technical feasibility of that at depends a lot on what the various DDC routine interfaces and associated structures are). Either way, you're possibly biting off a bit much at this stage.
Good luck.
IanH
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
>> With the * in your first datastuff declaration, you are declaring a two dimensional array of _pointers_ to double
Good catch Ian. One of those cannot see the trees from the forrest.
Jim
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
>> With the * in your first datastuff declaration, you are declaring a two dimensional array of _pointers_ to double
Good catch Ian. One of those cannot see the trees from the forrest.
Jim
Jim,Ian,
I plan to respond with a longer post but just to reply to the "*" pointer issue.
I can assure you, almostas sureas the sun sets in the west, the pope is catholic and one-legged ducks can only swim in circles that if you seea "*" direction symbol that I triedcompiling with and without it and that neither way worked (at least not in combination with how everything else is set in the code). :)
But now that I know for certain that I shouldn't be doing the pointing thing there I will leave it out.
Mike
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Yes, IanH's code is very useful. I think examples similar to these should be put in the IVF code examples folder. Progress I've made so far/comments/questions:
1) Using IanH's Module seedata example I am able to pass array data to my Fortran code. Wahooo!!
2) IanH, your seedata Module has the following in it:
[cpp] SUBROUTINE c_routine BIND(C)
! No arguments.
! Everything is global.
! Array dimensions are hard coded.
! All very bad.
END SUBROUTINE c_routine [/cpp]
What do you mean by "All very bad"??? This makes me nervous.
3) I also went back to my previous thread:
http://software.intel.com/en-us/forums/showthread.php?t=62464
and was able to compile and run IanH's string example codes. Very helpful. I can now pass strings from the Fortran side to C. Am doing so by passing through the call statement.
4) Right now though I'm having a devil of a time gettting strings from my C app to my Fortran one using the examples in IanH's example. Trying to go through the call statement again. I've tried to create a new variable on the C side but keep getting errors that might be related to in/out of scope issues. I think the problem has to do with the functions in my C app being static and void. The C app was designed to keep everything local. Wondering if it would be easier to go global with everything. Got to get an answer to the "All very bad" quote above. I'll plug away for a while longer and if I'm still stumped I'll post again with more information.
5) All in all though, major progress. Thanks again.
Mike
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
!
! FUNCTIONS/SUBROUTINES exported from strings.dll: FORTRDISPLAYMESSAGE
!
!This function is written to demonstrate how strings can be passed from and to a C++ main program
!to a Fortran DLL. __stdcall has been specified on the C++ side and the arguments are passed by reference
!STDCALL adds a leading underscore to the C++ function name and decorates it with '@16', the number
!being 4 times the number of arguments. The C++ function name is FORTDISPLAYMESSAGE and is case-sensItive,
!so the alias that has to be searched for by the Fortran linker is '_FORTDISPLAMESSAGE@16'
!
!
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_FORTDISPLAYMESSAGE@16' :: FORTDISPLAYMESSAGE
!DEC$ ATTRIBUTES DLLEXPORT::FORTDISPLAYMESSAGE
!DEC$ ATTRIBUTES REFERENCE:: lpszstring, strlength, strtospace
!DEC$ ATTRIBUTES REFERENCE::strtospacelength
! Variables
INTEGER STRLENGTH
integer strtospacelength
character(STRLENGTH) lpszstring
character(256) lpszstringtemp
character(strtospacelength) strtospace
integer lret
character(8) chlength
! Body of strings
write(chlength, '(i8)') STRLENGTH
lret=messagebox(null,'Input string length= '//chlength//char(0), 'FORTDISPLAYMESSAGE OUTPUT'C,MB_OK)
lret=messagebox(null,'Input string = '//lpszstring, 'FORTDISPLAYMESSAGE OUTPUT'C,MB_OK)
strtospacelength=min(INDEX(lpszstring,' ')-1,strtospacelength)
strtospace=lpszstring(1:strtospacelength)
lret=messagebox(null,'Output string length= '//chlength//char(0), 'FORTDISPLAYMESSAGE OUTPUT'C,MB_OK)
lret=messagebox(null,'Output string = '//strtospace(1:strtospacelength)//char(0), 'FORTDISPLAYMESSAGE OUTPUT'C,MB_OK)
Here is the C++ code:
// hello.cpp : Defines the entry point for the console application.
//
//This program demonstrates calling a Fortran function in a DLL compiled using Compaq Visual Fortran
//to pass character strings.
//
#include "stdafx.h"
#include
#include
using namespace std;
// In the Displaymessage function prototype, use ampersands to specify passing arguments by reference
//
void Displaymessage(string &lpszstring, int &strlength, string &strtospace, int &strtospacelength);
// Define the Fortran function as external and imported from a DLL. The export library generated with the
// Fortran DLL must be included in this C++ project so that the DLL and its exported function can
// be located.
extern "C" { __declspec(dllimport) void __stdcall FORTDISPLAYMESSAGE(char *lpszstring, int &strlength, char *lpszstrtospace, int &strtospacelength); }
int main(int argc, char* argv[])
{
//
// This program demonstrates the passing of character strings between C++ and Fortran via
// a C++ main program calling a function in a Fortran DLL.
// Two functions, one a C++ function (Displaymessage), the other a Fortran function (FORTDISPLAYMESSAGE)
// contained in a DLL called 'strings.dll' will be demonstrated. Each function takes a reference string
// and its length as input and each function returns a string and its length as output.
//
string reference = "C++ Language reference";// Define the reference string object
string stringtospace;// Define a string object returned by the C++ function
int length, lstrtospace;// Define variables for the string lengths
char * cstr;
// specify some reasonably large value for the character string (fourth argument) to be returned
// by the Fortran function FORTDISPLAYMESSAGE. Here we use a 256-character array
char cstringtospace[256];
char * cspace;
// Get the length of the reference string, used as the second argument to both functions
length=reference.length();
// Call the C++ function to print the reference string, its length and also the sub-string up to the
// first blank character and its length, returning the last two items in the third and fourth arguments.
Displaymessage(reference, length, stringtospace, lstrtospace);
// Prepare for calling the Fortran function. This function will not accept C++ string objects, but
// it will accept character strings, so the string stored in the C++ string object must be copied to
// a C-string
// So create a c-string to contain the contents of the string 'reference', terminated by
// a null-character, making its length 'length' 1 character longer than the string
// This C-string is used as the first argument to the Fortran function FORTDISPLAYMESSAGE
// Its length, including null character, is used as the second argument
cstr = new char [reference.size()+1];
strcpy (cstr, reference.c_str());
length=reference.size()+1;
//On input, lstrtospace equals the defined size of the character array cstringtospace
lstrtospace=sizeof(cstringtospace);
// Call the function to put up message boxes equivalent to the data printed to console by the
// C++ function (the console in the C++ main program is not available to the Fortran function).
FORTDISPLAYMESSAGE(cstr, length, cstringtospace, lstrtospace);
// Show that the values generated by the Fortran function and returned in the third and fourth arguments
// are correct. Begin with the fourth argument, the returned string length.
cout << "The FORTDISPLAYMESSAGE output string length = " << lstrtospace << " characters." << endl;
// The third argument is the output character string, presently defined with the maximum length given
// by the fourth argument. On return, its new length is given by the fourth argument and it will not
// have been terminated with a null character in FORTDISPLAYMESSAGE.
// The character string is copied to a newly-created character array 'cspace' and a null character appended.
cspace = new char [lstrtospace+1];
strncpy(cspace,cstringtospace,lstrtospace);
cspace[lstrtospace]='�';
cout << endl << "The FORTDISPLAYMESSAGE output string is " << cspace << endl;
return 0;
}
void Displaymessage(string &lpszstring, int &strlength, string &strtospace, int &strtospacelength)
{
int ltoblank;
cout << "The Displaymessage input string is " << lpszstring << endl;
cout << "The Displaymessage input string length = " << strlength << " characters." << endl;
// Locate the first blank character in the string and copy the string up to that location into
// string variable 'strtospace'
ltoblank = lpszstring.find_first_of(" ");
strtospace=lpszstring.substr(0,ltoblank);
cout << "The Displaymessage output string is " << strtospace << endl;
cout << "The Displaymessage output string length = " << ltoblank << " characters." << endl;
}
The C++ code just needs the standard include file StdAfx.cpp. Hope this helps.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
[cpp] ! Everything is global.
! Array dimensions are hard coded.
! All very bad.[/cpp]
Apologies - I was just being flippant about coding style, nothing to do with ISO_C_BINDING per se. The hard coded array dimensions in the sample aren't very "robust" - consider what happens when you make a change to array dimensions on one side (Fortran or C) and then forget to update the other side. This sort of bug can be a real pain to track down. Similar anti-global-variable-philosophies exist.
What is appropriate depends on your specific application and your specific style.
IanH
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Different C++ string example, which uses ISO_C_BINDING, is not set up for a DLL and maintains the Fortran idiom of filling things with spaces rather than using terminating 0's. You can take advantage of some of the C++ std requirements for std::basic_string to make life a bit easier. Backing storage for the string on the C++ side could also be provided by std::vector
Again, this was derived from something I put together while learning this stuff, so there may be issues I'm not aware of.
IanH
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Different C++ string example, which uses ISO_C_BINDING, is not set up for a DLL and maintains the Fortran idiom of filling things with spaces rather than using terminating 0's. You can take advantage of some of the C++ std requirements for std::basic_string to make life a bit easier. Backing storage for the string on the C++ side could also be provided by std::vector
Again, this was derived from something I put together while learning this stuff, so there may be issues I'm not aware of.
IanH
Fortran
[cpp]C********************************************************************
C
C SUBROUTINE READDATAFILE.for
C
C This subroutine reads the data file and stores the information
C in the QAEU Common
C
C********************************************************************
MODULE seedata
USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
! The data
REAL(C_DOUBLE), BIND(C) :: datastuff(90000,500)
CHARACTER(15,C_Char), BIND(C) :: grpnm
c Does the 15 need to be 1?
c CHARACTER(KIND=C_CHAR), DIMENSION(*) :: grpnm
INTERFACE
SUBROUTINE MAIN BIND(C)
! No arguments.
! Everything is global.
! Array dimensions are hard coded.
! All very bad.
c CHARACTER(KIND=C_CHAR), DIMENSION(80) :: grpnm
END SUBROUTINE
END INTERFACE
END MODULE seedata
Program READDATAFILE
USE seedata
implicit none
c INTERFACE (old interface routine)
c SUBROUTINE MAIN (int_arg, str_in)
c SUBROUTINE MAIN (int_arg)
! Specify C calling and naming conventions
c !DEC$ ATTRIBUTES C :: MAIN
c !DEC$ ATTRIBUTES :: int_arg
c INTEGER, INTENT(IN) :: int_arg
c INTEGER :: int_arg
cc CHARACTER(*) str_in
!
! Specify that the CHARACTER arguments are by reference
! with no hidden length
cc !DEC$ ATTRIBUTES REFERENCE :: str_in
c END SUBROUTINE MAIN
c END INTERFACE
c Common /mystuff/ datastuff
CHARACTER(80) OUTPUT_TEXT,str_out
CHARACTER(LEN=80,KIND=C_CHAR) :: str1
c CHARACTER(LEN=15,KIND=C_CHAR) :: grpnm
INTEGER*4 INT_ARG, OUTPUT_LEN
CHARACTER(80) INPUT_TEXT
c real*8 DATASTUFF(90000,500)
str1 = C_CHAR_"TestYo..." // C_NULL_CHAR
int_arg = 123
Call MAIN(datastuff, int_arg, str1, grpnm)
c call main(datastuff)
c RETURN
END[/cpp]
[cpp]//----------------------------------------------------------------------------- // // This sample program shows how to read a DIAdem file. // //----------------------------------------------------------------------------- //----------------------------------------------------------------------------- // Include files //----------------------------------------------------------------------------- #include "nilibddc.h" #include#include #include //#define Dllimport __declspec( dllimport ) //MJB //#define DllExport __declspec( dllexport ) //MJB //#define _main main //MJB //DllExport MAIN(); //MJB //extern MAIN(); //MJB Doing this allows debugging from FortRead to go into CDLL //----------------------------------------------------------------------------- // Macros //----------------------------------------------------------------------------- #define ddcChk(f) if (ddcError = (f), ddcError < 0) goto Error; else #ifdef nullChk #undef nullChk #endif #define nullChk(p) if (!(p)) { ddcError = DDC_OutOfMemory; goto Error; } else //----------------------------------------------------------------------------- // Constants //----------------------------------------------------------------------------- //static const char * FILE_PATH = "testtdms.tdms"; static const char * FILE_PATH = "C:ACS11_3_2008_2_57.tdms"; //static const char * FILE_PATH = "C:ACS2_6_2008_9_58 AM.tdms"; //----------------------------------------------------------------------------- // Forward declarations //----------------------------------------------------------------------------- static int ReadFile (void); static int ReadGroups (DDCFileHandle file); static int ReadChannels (DDCChannelGroupHandle group); double GetAvgDataValue (unsigned __int64 numDataValues, double *data); #define cols 500 //MJB #define rows 90000 //MJB void fix_string_for_f90(char output_text[], size_t slen); //MJB extern double datastuff[cols][rows]; //MJB int count; //MJB char *grpnm; //MJB ************************************* /*12/23: This is where I think I'm declaring grpnm to be global */ //int ivf_grpnm_len; //MJB //int *argc //----------------------------------------------------------------------------- // Program entry-point function //----------------------------------------------------------------------------- //int MAIN (int argc, char *argv[]) //Original commented out by MJB //MAIN (double *array2) //MJB MAIN (double *array2, int *argc, char* str1, char* grpnm, int ivf_grpnm_len) //MJB /*12/23: str1 is passed here from fortran and appears okay,at least to this point. I'm concentrating on grpnm: trying to pass this back to Fortran. ivf_grpnm_lens is that sneaky hidden fortran length parameter. I need to determine this in the code but I don't think I've done that yet since I can't seem to set grpnm to the right value.*/ { int ddcError = 0; *argc = 2; //MJB Simply added in attempt to pass an integer. Not integral to original code ddcChk (ReadFile()); Error: if (ddcError < 0) printf ("nError: %sn", DDC_GetLibraryErrorDescription(ddcError)); else printf ("nNo errors.n"); printf("End of program, press Enter key to quitn"); getchar(); return 0; } //----------------------------------------------------------------------------- // Helper functions //----------------------------------------------------------------------------- // Reads the file static int ReadFile (void) { int ddcError = 0; unsigned int length; DDCFileHandle file = 0; char *property = 0; // char* grpnm; // Read file name ddcChk (DDC_OpenFile (FILE_PATH, "TDMS", &file)); ddcChk (DDC_GetFileStringPropertyLength (file, DDC_FILE_NAME, &length)); nullChk (property = (char *)malloc (length + 1)); ddcChk (DDC_GetFileProperty (file, DDC_FILE_NAME, property, length + 1)); // printf ("File name property: %sn", property); //MJB Don't need for my app free (property); property = 0; // Read file description, if present if (DDC_GetFileStringPropertyLength (file, DDC_FILE_DESCRIPTION, &length) >= 0) { nullChk (property = (char *)malloc (length + 1)); ddcChk (DDC_GetFileProperty (file, DDC_FILE_DESCRIPTION, property, length + 1)); // printf ("File description property: %sn", property); //MJB Don't need for my app free (property); property = 0; } // Read the channel groups ddcChk (ReadGroups (file)); Error: if (property) free (property); if (file) DDC_CloseFile (file); return ddcError; } // Reads all the channel groups in a file static int ReadGroups (DDCFileHandle file) { int ddcError = 0; unsigned int length; unsigned int i, numGroups; DDCChannelGroupHandle *groups = 0; char *property = 0; // grpnm=0; // Get all the channel groups ddcChk (DDC_GetNumChannelGroups (file, &numGroups)); nullChk (groups = (DDCChannelGroupHandle *)calloc (numGroups, sizeof (DDCChannelGroupHandle))); ddcChk (DDC_GetChannelGroups (file, groups, numGroups)); for (i = 0; i < numGroups; ++i) { // Read the channel group name ddcChk (DDC_GetChannelGroupStringPropertyLength (groups, DDC_CHANNELGROUP_NAME, &length)); nullChk (property = (char *)malloc (length + 1)); ddcChk (DDC_GetChannelGroupProperty (groups, DDC_CHANNELGROUP_NAME, property, length + 1)); /* *********************************************************** */ /* Here's where I want to set the character string that "property" points to someplace "permanent", like grpnm, so I can sent it back to Fortran. Before the next line when I'm debugging, "grpnm "cannot be evaulated". */ grpnm = property;
/*I know, grpnm is just looking at what property is pointing too, when property is freed below, so is grpnm, but this is the only way to run the code through without choking. property has (points to) the correct string and has a total length of 17; the "null" character is at array index 16.*/ // sprintf(grpnm, "%s", property);
strcpy(grpnm, property);
/* I believe strcopy is the way to set a value to a variable as opposed to an address but I can't get it to work here*/
fix_string_for_f90(grpnm, 15 /* ivf_str4_len */ ); /* I know that I have some kind of string length issue. property is of variable length and I somehow have to get grpnm's length to agree???? I know at some point I need to determine the length of property (and add 1 and have it replace the "15" in the "fix_string_...." line. And I believe that if property were to be less than 15 (+or-1) I would have problems (for the moment I know that the two values (this part of the code loops twice)that go into property are more than 15 characters)*/ /* *********************************************************** */ // printf ("n"); //Original code // printf ("Channelgroup #%d name property: %sn", i+1, property); //Original code
free (property); property = 0; // Read the channel group description, if present if (DDC_GetChannelGroupStringPropertyLength (groups, DDC_CHANNELGROUP_DESCRIPTION, &length) >= 0) { nullChk (property = (char *)malloc (length + 1)); ddcChk (DDC_GetChannelGroupProperty (groups, DDC_CHANNELGROUP_DESCRIPTION, property, length + 1)); printf ("Channelgroup #%d description property: %sn", i+1, property); free (property); property = 0; } // Read the channels in this group ddcChk (ReadChannels (groups)); } Error: // Cleanup if (groups) free (groups); if (property) free (property); return ddcError; } // Reads all the channels in a channel group static int ReadChannels (DDCChannelGroupHandle group) { int ddcError = 0; unsigned int i, numChannels, length; unsigned __int64 numDataValues; DDCChannelHandle *channels = 0; char *property = 0; double *data = 0; //avgDataValue; // Read all the channels in this channel group ddcChk (DDC_GetNumChannels (group, &numChannels)); nullChk (channels = (DDCChannelHandle *) calloc (numChannels, sizeof (DDCChannelHandle))); ddcChk (DDC_GetChannels (group, channels, numChannels)); for (i = 0; i < numChannels; ++i) { // Read the channel name ddcChk (DDC_GetChannelStringPropertyLength (channels, DDC_CHANNEL_NAME, &length)); nullChk (property = (char *) malloc (length + 1)); ddcChk (DDC_GetChannelProperty (channels, DDC_CHANNEL_NAME, property, length + 1)); printf ("n"); // printf ("Channel #%d name property: %sn", i+1, property); free (property); property = 0; // Read the channel description, if present if (DDC_GetChannelStringPropertyLength (channels, DDC_CHANNEL_DESCRIPTION, &length) >= 0) { nullChk (property = (char *)malloc (length + 1)); ddcChk (DDC_GetChannelProperty (channels, DDC_CHANNEL_DESCRIPTION, property, length + 1)); // printf ("Channel #%d description property: %sn", i+1, property); free (property); property = 0; } // Read the channel units, if present if (DDC_GetChannelStringPropertyLength (channels, DDC_CHANNEL_UNIT_STRING, &length) >= 0) { nullChk (property = (char *)malloc (length + 1)); ddcChk (DDC_GetChannelProperty (channels, DDC_CHANNEL_UNIT_STRING, property, length + 1)); printf ("Channel #%d unit string property: %sn", i+1, property); free (property); property = 0; } // Read the channel data ddcChk (DDC_GetNumDataValues (channels, &numDataValues)); nullChk (data = (double *) malloc (sizeof (double) * (unsigned int)numDataValues)); ddcChk (DDC_GetDataValues (channels, 0, (unsigned int)numDataValues, data)); for (count =1; count<=numDataValues; count++) //MJB datastuff[count] = data[count]; //MJB // avgDataValue = GetAvgDataValue (numDataValues, data); //MJB Orig code, don't need // printf ("Channel #%d number of data values: %I64dn", i+1, numDataValues); //MJB Orig code, don't need // printf ("Channel #%d average data value: %.2fn", i+1, avgDataValue); //MUB " " " " } Error: // Cleanup if (data) free (data); if (channels) free (channels); if (property) free (property); return ddcError; } double GetAvgDataValue (unsigned __int64 numDataValues, double *data) { int i; double sum = 0.0; for (i = 0; i < numDataValues; i++) sum += data; return sum / (unsigned int)numDataValues; } void fix_string_for_f90(char s[], size_t len) { size_t i; /* Avoid size_t != int warnings */ for (i = strlen(s); i < len; i++) s = ' '; } [/cpp]
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Fortran
[cpp]C********************************************************************
C
C SUBROUTINE READDATAFILE.for
C
C This subroutine reads the data file and stores the information
C in the QAEU Common
C
C********************************************************************
MODULE seedata
USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
! The data
REAL(C_DOUBLE), BIND(C) :: datastuff(90000,500)
CHARACTER(15,C_Char), BIND(C) :: grpnm
c Does the 15 need to be 1?
c CHARACTER(KIND=C_CHAR), DIMENSION(*) :: grpnm
INTERFACE
SUBROUTINE MAIN BIND(C)
! No arguments.
! Everything is global.
! Array dimensions are hard coded.
! All very bad.
c CHARACTER(KIND=C_CHAR), DIMENSION(80) :: grpnm
END SUBROUTINE
END INTERFACE
END MODULE seedata
Program READDATAFILE
USE seedata
implicit none
c INTERFACE (old interface routine)
c SUBROUTINE MAIN (int_arg, str_in)
c SUBROUTINE MAIN (int_arg)
! Specify C calling and naming conventions
c !DEC$ ATTRIBUTES C :: MAIN
c !DEC$ ATTRIBUTES :: int_arg
c INTEGER, INTENT(IN) :: int_arg
c INTEGER :: int_arg
cc CHARACTER(*) str_in
!
! Specify that the CHARACTER arguments are by reference
! with no hidden length
cc !DEC$ ATTRIBUTES REFERENCE :: str_in
c END SUBROUTINE MAIN
c END INTERFACE
c Common /mystuff/ datastuff
CHARACTER(80) OUTPUT_TEXT,str_out
CHARACTER(LEN=80,KIND=C_CHAR) :: str1
c CHARACTER(LEN=15,KIND=C_CHAR) :: grpnm
INTEGER*4 INT_ARG, OUTPUT_LEN
CHARACTER(80) INPUT_TEXT
c real*8 DATASTUFF(90000,500)
str1 = C_CHAR_"TestYo..." // C_NULL_CHAR
int_arg = 123
Call MAIN(datastuff, int_arg, str1, grpnm)
c call main(datastuff)
c RETURN
END[/cpp]
[cpp]//-----------------------------------------------------------------------------
//
// This sample program shows how to read a DIAdem file.
//
//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
// Include files
//-----------------------------------------------------------------------------
#include "nilibddc.h"
#include
#include
#include
//#define Dllimport __declspec( dllimport ) //MJB
//#define DllExport __declspec( dllexport ) //MJB
//#define _main main //MJB
//DllExport MAIN(); //MJB
//extern MAIN(); //MJB Doing this allows debugging from FortRead to go into CDLL
//-----------------------------------------------------------------------------
// Macros
//-----------------------------------------------------------------------------
#define ddcChk(f) if (ddcError = (f), ddcError < 0) goto Error; else
#ifdef nullChk
#undef nullChk
#endif
#define nullChk(p) if (!(p)) { ddcError = DDC_OutOfMemory; goto Error; } else
//-----------------------------------------------------------------------------
// Constants
//-----------------------------------------------------------------------------
//static const char * FILE_PATH = "testtdms.tdms";
static const char * FILE_PATH = "C:ACS11_3_2008_2_57.tdms";
//static const char * FILE_PATH = "C:ACS2_6_2008_9_58 AM.tdms";
//-----------------------------------------------------------------------------
// Forward declarations
//-----------------------------------------------------------------------------
static int ReadFile (void);
static int ReadGroups (DDCFileHandle file);
static int ReadChannels (DDCChannelGroupHandle group);
double GetAvgDataValue (unsigned __int64 numDataValues, double *data);
#define cols 500 //MJB
#define rows 90000 //MJB
void fix_string_for_f90(char output_text[], size_t slen); //MJB
extern double datastuff[cols][rows]; //MJB
int count; //MJB
char *grpnm; //MJB *************************************
/*12/23: This is where I think I'm declaring grpnm to be global */
//int ivf_grpnm_len; //MJB
//int *argc
//-----------------------------------------------------------------------------
// Program entry-point function
//-----------------------------------------------------------------------------
//int MAIN (int argc, char *argv[]) //Original commented out by MJB
//MAIN (double *array2) //MJB
MAIN (double *array2, int *argc, char* str1, char* grpnm, int ivf_grpnm_len) //MJB
/*12/23: str1 is passed here from fortran and appears okay,at least to this point. I'm concentrating on grpnm: trying to pass
this back to Fortran. ivf_grpnm_lens is that sneaky hidden fortran length parameter. I need to determine
this in the code but I don't think I've done that yet since I can't seem to set grpnm to the right value.*/
{
int ddcError = 0;
*argc = 2; //MJB Simply added in attempt to pass an integer. Not integral to original code
ddcChk (ReadFile());
Error:
if (ddcError < 0)
printf ("nError: %sn", DDC_GetLibraryErrorDescription(ddcError));
else
printf ("nNo errors.n");
printf("End of program, press Enter key to quitn");
getchar();
return 0;
}
//-----------------------------------------------------------------------------
// Helper functions
//-----------------------------------------------------------------------------
// Reads the file
static int ReadFile (void)
{
int ddcError = 0;
unsigned int length;
DDCFileHandle file = 0;
char *property = 0;
// char* grpnm;
// Read file name
ddcChk (DDC_OpenFile (FILE_PATH, "TDMS", &file));
ddcChk (DDC_GetFileStringPropertyLength (file, DDC_FILE_NAME, &length));
nullChk (property = (char *)malloc (length + 1));
ddcChk (DDC_GetFileProperty (file, DDC_FILE_NAME, property, length + 1));
// printf ("File name property: %sn", property); //MJB Don't need for my app
free (property);
property = 0;
// Read file description, if present
if (DDC_GetFileStringPropertyLength (file, DDC_FILE_DESCRIPTION, &length) >= 0)
{
nullChk (property = (char *)malloc (length + 1));
ddcChk (DDC_GetFileProperty (file, DDC_FILE_DESCRIPTION, property, length + 1));
// printf ("File description property: %sn", property); //MJB Don't need for my app
free (property);
property = 0;
}
// Read the channel groups
ddcChk (ReadGroups (file));
Error:
if (property)
free (property);
if (file)
DDC_CloseFile (file);
return ddcError;
}
// Reads all the channel groups in a file
static int ReadGroups (DDCFileHandle file)
{
int ddcError = 0;
unsigned int length;
unsigned int i, numGroups;
DDCChannelGroupHandle *groups = 0;
char *property = 0;
// grpnm=0;
// Get all the channel groups
ddcChk (DDC_GetNumChannelGroups (file, &numGroups));
nullChk (groups = (DDCChannelGroupHandle *)calloc (numGroups, sizeof (DDCChannelGroupHandle)));
ddcChk (DDC_GetChannelGroups (file, groups, numGroups));
for (i = 0; i < numGroups; ++i)
{
// Read the channel group name
ddcChk (DDC_GetChannelGroupStringPropertyLength (groups, DDC_CHANNELGROUP_NAME,
&length));
nullChk (property = (char *)malloc (length + 1));
ddcChk (DDC_GetChannelGroupProperty (groups, DDC_CHANNELGROUP_NAME,
property, length + 1));
/* *********************************************************** */
/* Here's where I want to set the character string that "property" points to someplace "permanent", like grpnm, so I can sent it back to Fortran. Before the next line when I'm debugging, "grpnm "cannot be evaulated".
*/
grpnm = property;
/*I know, grpnm is just looking at what property is pointing too, when property is freed below, so is grpnm, but this is the only way to run the code through without choking. property has (points to) the correct string and has a total length of 17; the "null" character is at array index 16.*/
// sprintf(grpnm, "%s", property);
strcpy(grpnm, property);
/* I believe strcopy is the way to set a value to a variable as opposed to an address but I can't get it to work here*/
fix_string_for_f90(grpnm, 15 /* ivf_str4_len */ );
/* I know that I have some kind of string length issue. property is of variable length and I somehow have to get grpnm's length to agree???? I know at some point I need to determine the length of property (and add 1
and have it replace the "15" in the "fix_string_...." line. And I believe that if property were to be less than 15 (+or-1) I would have problems (for the moment I know that the two values (this part of the code loops
twice)that go into property are more than 15 characters)*/
/* *********************************************************** */
// printf ("n"); //Original code
// printf ("Channelgroup #%d name property: %sn", i+1, property); //Original code
free (property);
property = 0;
// Read the channel group description, if present
if (DDC_GetChannelGroupStringPropertyLength (groups,
DDC_CHANNELGROUP_DESCRIPTION, &length) >= 0)
{
nullChk (property = (char *)malloc (length + 1));
ddcChk (DDC_GetChannelGroupProperty (groups, DDC_CHANNELGROUP_DESCRIPTION,
property, length + 1));
printf ("Channelgroup #%d description property: %sn", i+1, property);
free (property);
property = 0;
}
// Read the channels in this group
ddcChk (ReadChannels (groups));
}
Error:
// Cleanup
if (groups)
free (groups);
if (property)
free (property);
return ddcError;
}
// Reads all the channels in a channel group
static int ReadChannels (DDCChannelGroupHandle group)
{
int ddcError = 0;
unsigned int i, numChannels, length;
unsigned __int64 numDataValues;
DDCChannelHandle *channels = 0;
char *property = 0;
double *data = 0; //avgDataValue;
// Read all the channels in this channel group
ddcChk (DDC_GetNumChannels (group, &numChannels));
nullChk (channels = (DDCChannelHandle *) calloc (numChannels, sizeof (DDCChannelHandle)));
ddcChk (DDC_GetChannels (group, channels, numChannels));
for (i = 0; i < numChannels; ++i)
{
// Read the channel name
ddcChk (DDC_GetChannelStringPropertyLength (channels, DDC_CHANNEL_NAME, &length));
nullChk (property = (char *) malloc (length + 1));
ddcChk (DDC_GetChannelProperty (channels, DDC_CHANNEL_NAME, property, length + 1));
printf ("n");
// printf ("Channel #%d name property: %sn", i+1, property);
free (property);
property = 0;
// Read the channel description, if present
if (DDC_GetChannelStringPropertyLength (channels, DDC_CHANNEL_DESCRIPTION, &length) >= 0)
{
nullChk (property = (char *)malloc (length + 1));
ddcChk (DDC_GetChannelProperty (channels, DDC_CHANNEL_DESCRIPTION,
property, length + 1));
// printf ("Channel #%d description property: %sn", i+1, property);
free (property);
property = 0;
}
// Read the channel units, if present
if (DDC_GetChannelStringPropertyLength (channels, DDC_CHANNEL_UNIT_STRING, &length) >= 0)
{
nullChk (property = (char *)malloc (length + 1));
ddcChk (DDC_GetChannelProperty (channels, DDC_CHANNEL_UNIT_STRING,
property, length + 1));
printf ("Channel #%d unit string property: %sn", i+1, property);
free (property);
property = 0;
}
// Read the channel data
ddcChk (DDC_GetNumDataValues (channels, &numDataValues));
nullChk (data = (double *) malloc (sizeof (double) * (unsigned int)numDataValues));
ddcChk (DDC_GetDataValues (channels, 0, (unsigned int)numDataValues, data));
for (count =1; count<=numDataValues; count++) //MJB
datastuff[count] = data[count]; //MJB
// avgDataValue = GetAvgDataValue (numDataValues, data); //MJB Orig code, don't need
// printf ("Channel #%d number of data values: %I64dn", i+1, numDataValues); //MJB Orig code, don't need
// printf ("Channel #%d average data value: %.2fn", i+1, avgDataValue); //MUB " " " "
}
Error:
// Cleanup
if (data)
free (data);
if (channels)
free (channels);
if (property)
free (property);
return ddcError;
}
double GetAvgDataValue (unsigned __int64 numDataValues, double *data)
{
int i;
double sum = 0.0;
for (i = 0; i < numDataValues; i++)
sum += data;
return sum / (unsigned int)numDataValues;
}
void fix_string_for_f90(char s[], size_t len)
{
size_t i; /* Avoid size_t != int warnings */
for (i = strlen(s); i < len; i++) s = ' ';
} [/cpp]
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page