I've just stumbled upon the fact that compiler lets me use integer arrays as indices to other arrays. For example:
implicit none
real*8 :: a(3), b(2)
integer :: idx(2)
a=1.d0
idx=(/1,2/)
b = a(idx)
print*,shape(b)
print*,b
print*
end
Given the fact that this seems to work with both gfortan and a PGI compiler, I'm wondering if this a language feature rather than something compiler just lets me out with. I would appreciate if somebody more knowledgeable than me can comment if this is really a language feature.
And if it is, than I'd appreciate if somebody would spell out the exact language rules of how such constructions are interpreted in multidimensional case, like here:
implicit none
real*8 :: aa(3,3), bb(2,2)
integer :: idx(2)
do i=1,3 ; do j=1,3
aa(i,j) = 1.d0*(i+j)
enddo; enddo
bb=aa(idx,idx)
print*,shape(bb)
print*,bb
end
Yes, it is.
The final draft of the Fortran 2008 standard, ISO/IEC JTC 1/SC 22/WG 5/N1830, ftp://ftp.nag.co.uk/sc22wg5/N1801-N1850/N1830.pdf says on page 84
4.8 Construction of array values
...
6 If an ac-value is an array expression, the values of the elements of the expression, in array element order (6.5.3.2), specify the corresponding sequence of elements of the array constructor.
Example
real, dimension(20) :: b
...
k = (/3, 1, 4/)
b(k) = 0.0 ! section b(k) is a rank-one array with shape (3) and
! size 3. (0.0 is assigned to b(1), b(3), and b(4).)
The rules you can see directly from your code
implicit none
real*8 :: aa(3,3), bb(2,2)
integer :: idx(2),i,j,k
idx=(/3, 2/)
k=0
do i=1,3 ; do j=1,3
k=k+1
aa(i,j) = aa(i,j)+1.d0*k
enddo; enddo
write(*,*),shape(aa)
write(*,'(3G24.6,2X)') aa
bb=aa(idx,idx)
print*,shape(bb)
write(*,'(2G24.6,2X)'),bb
end
Output:
3 3
1.00000 4.00000 7.00000
2.00000 5.00000 8.00000
3.00000 6.00000 9.00000
2 2
9.00000 6.00000
8.00000 5.00000
Related
Can anyone help me to find where I am going wrong about writing this code
program time_period
! This program calculates time period of an SHM given length of the chord
implicit none
integer, parameter:: length=10
real, parameter :: g=9.81, pi=3.1415926535897932384
integer, dimension(1:length)::chordlength
integer :: l
real :: time
do l= 1,length
time = 2*pi*(chordlength(l)/(g))**.5
print *, l, time
enddo
end program
Result:
1 0.00000000E+00
2 0.00000000E+00
3 0.00000000E+00
4 0.00000000E+00
5 0.00000000E+00
6 0.00000000E+00
7 0.00000000E+00
8 0.00000000E+00
9 0.00000000E+00
10 0.00000000E+00
If the chord lengths you're interested are the integer values 1,2,...,10 you hardly need an array to store them. Further, if what you are interested in are the SHM period lengths for each of those 10 chord lengths, it strikes me that you should have an array like this:
real, dimension(length) :: shm_periods
which you would then populate, perhaps like this:
do l= 1,length
shm_periods(l) = 2*pi*(l/g)**.5
print *, l, shm_periods(l)
enddo
Next, you could learn about Fortran's array syntax and write only one statement to assign values to shm_periods.
#High Performance Mark
i worked it the following way
program time_period
! This program calculates time period of an SHM given length of the chord
implicit none
integer, parameter:: length=10
real, parameter :: g=9.81, pi=3.1415926535897932384
integer, dimension(1:length)::chordlength
integer :: l
real, dimension(1:length) :: timeperiod
do l= 1,length
print *, 'Enter ChordLength', l
read *, chordlength(l)
timeperiod(l) = 2*pi*(chordlength(l)/g)**.5
enddo
do l=1,length
print *, l, timeperiod(l)
enddo
end program
its giving me results but asking to type the chord lengths...appreciate your help
The code below does not answer your question (since you already did that). But it does address some issues with the design of the code.
As a next step, lets say you want to use a) a function for the calculation, b) have some standard length values to display the period and c) input a custom length for calculation.
Fortran allows for the declaration of elemental functions which can operate on single values or arrays just the same (with no need for a loop). See the example below:
elemental function CalcTimePeriod(chord_length) result(period)
! Calculate the SHM time period from the chord length
real, parameter :: g=9.80665, pi=3.1415926535897932384
real, intent(in) :: chord_length
real :: period
period = 2*pi*sqrt(chord_length/g)
end function
So I am posting the code below in hopes that you can learn something new with modern Fortran.
program SHM_CalcTime
implicit none
! Variables
integer, parameter :: n = 10
real, dimension(n) :: gen_lengths, periods
real :: input_length
integer :: i
! Example calculation from generated array of chord lengths
! fill an array of lengths using the formula len = 1.0 + (i-1)/2
gen_lengths = [ (1.0+real(i-1)/2, i=1, n) ]
! calculate the time periods for ALL the lengths in the array
periods = CalcTimePeriod(gen_lengths)
write (*, '(1x,a14,1x,a18)') 'length', 'period'
do i=1,n
write (*, '(1x,g18.4,1x,g18.6)') gen_lengths(i), periods(i)
end do
input_length = 1.0
do while( input_length>0 )
write (*,*) 'Enter chord length (0 to exit):'
read (*,*) input_length
if(input_length<=0.0) then
exit
end if
write (*, '(1x,g18.4,1x,g18.6)') input_length, CalcTimePeriod(input_length)
end do
contains
elemental function CalcTimePeriod(chord_length) result(period)
! Calculate the SHM time period from the chord length
real, parameter :: g=9.80665, pi=3.1415926535897932384
real, intent(in) :: chord_length
real :: period
period = 2*pi*sqrt(chord_length/g)
end function
end program SHM_CalcTime
On a final note, see that programs can have internal functions declared after a contains statement, with no need for an explicit interface declaration as you would with older Fortran variants.
I'm writing a subroutine that transform a regular vector into the one with only non-zero elements. Say, vector a=(0,0,1,2,3)' (n by 1). Then the non-zero vector is c=(1,2,3), and the row index is recorded as ic=(0,0,0,1,2,3) where ic(1)=0, ic(i+1)-ic(i) is the number of non-zero elements in i-th row. The vector index jc=(1,1,1) with size 3 as there are 3 non-zero entries. See the sparse matrix wiki for FYI: https://en.wikipedia.org/wiki/Sparse_matrix.
Despite its simplicity, I'm having troubles in running the following code named sparsem.f90
!This subroutine coverts a regular sparse matrix a into a CSR form
MODULE SPARSEM
CONTAINS
SUBROUTINE vsparse(a,c,jc,ic,counta,ierr,myid)
IMPLICIT NONE
REAL(8), INTENT(IN):: a(:)
INTEGER, INTENT(IN):: counta,myid
REAL(8), INTENT(OUT):: c(counta)
INTEGER, INTENT(OUT):: jc(counta),ic(size(a)+1)
INTEGER:: ierr,countaa,i
character(len=90):: filename
ierr=0
jc=0
c=0.0d0
ic=0
PRINT *, 'SIZE OF A IN VSPARSE', size(a),count(a>0.0d0),counta
IF (COUNT(a>0.0d0) /= counta) THEN
ierr=1
PRINT *, 'ERROR: number count of non-zero a(i,j) is not', counta
ELSE
countaa=0
ic(1)=0
DO i=1,size(a)
IF (a(i) > 0.0d0 ) THEN
countaa=countaa+1
c(countaa)=a(i)
ic(i+1)=ic(i)+1
jc(countaa)=1
IF (countaa<100) PRINT *,'checkcheckcheck', a(i), &
countaa,jc(countaa),c(countaa)，jc(1:5)
ELSE
ic(i+1)=ic(i)
END IF
END DO
PRINT *, 'JCJCJCJC',jc(1:5)
END IF
IF (myid==7) THEN
WRITE(filename,'("sparsedens_dcheck",I1,".txt")') myid+1
OPEN(UNIT=212101, FILE="/home/wenya/Workspace/Model4/valuef/"//filename,ACTION='write',status='replace')
DO i=1,counta+1
IF (i<=counta) THEN
WRITE(212101,*) c(i),jc(i)
ELSE
WRITE(212101,*) 0.0D0,0
END IF
END DO
CLOSE(212101)
END IF
return
END SUBROUTINE vsparse
END MODULE SPARSEM
So the three print jc codes shall give 1 1 1 1 1.... Yet starting from the second print jc code, the result is 6750960 6750691 6750692 .... The array of jc has size 9,000,000. And I know the first 2250000 element is 0.
To replicate this problem, here is the main program
PROGRAM MAIN
USE SPARSEM
IMPICIT NONE
REAL(8):: dens_last(9000000)
REAL(8), ALLOCATABLE :: dens(:)
INTEGER, ALLOCATABLE :: ic(:),jc(:)
INTEGER:: i
dens_last(1:2250000)=0.0d0
dens_last(2250001:9000000)=1.0d0/6750000.0d0
ncount=count(dens_last>0.0d0)
ALLOCATE(dens(ncount), ic(9000000+1), jc(ncount)_
CALL VSPASEM(dens_last, dens, jc, ic, ncount,ierr)
DEALLOCATE(dens,ic,jc)
END PROGRAM MAIN
I am using gfortran 6.3.0 and openmpi latest version on a UBUNTU 17.04 computer. Although openmpi is not used in this example, it's used in the rest of the program. Any thoughts? Thanks!
Hermite Interpolation woes
I am trying to find the Newton Dividing Differences for the function and derivative values of a given set of x's. I'm running into serious problems with my code working for tiny examples, but failing on bigger one's. As is clearly visible, my answers are very much larger than they original function values.
Does anybody have any idea what I'm doing wrong?
program inter
implicit none
integer ::n,m
integer ::i
real(kind=8),allocatable ::xVals(:),fxVals(:),newtonDivDiff(:),dxVals(:),zxVals(:),zdxVals(:),zfxVals(:)
real(kind=8) ::Px
real(kind=8) ::x
Open(Unit=8,File="data/xVals")
Open(Unit=9,File="data/fxVals")
Open(Unit=10,File="data/dxVals")
n = 4 ! literal number of data pts
m = n*2+1
!after we get the data points allocate the space
allocate(xVals(0:n))
allocate(fxVals(0:n))
allocate(dxVals(0:n))
allocate(newtonDivDiff(0:n))
!allocate the zvalue arrays
allocate(zxVals(0:m))
allocate(zdxVals(0:m))
allocate(zfxVals(0:m))
!since the size is the same we can read in one loop
do i=0,n
Read(8,*) xVals(i)
Read(9,*) fxVals(i)
Read(10,*) dxVals(i)
end do
! contstruct the z illusion
do i=0,m,2
zxVals(i) = xVals(i/2)
zxVals(i+1) = xVals(i/2)
zdxVals(i) = dxVals(i/2)
zdxVals(i+1) = dxVals(i/2)
zfxVals(i) = fxVals(i/2)
zfxVals(i+1) = fxVals(i/2)
end do
!slightly modified business as usual
call getNewtonDivDiff(zxVals,zdxVals,zfxVals,newtonDivDiff,m)
do i=0,n
call evaluatePolynomial(m,newtonDivDiff,xVals(i),Px,zxVals)
print*, xVals(i) ,Px
end do
close(8)
close(9)
close(10)
stop
deallocate(xVals,fxVals,dxVals,newtonDivDiff,zxVals,zdxVals,zfxVals)
end program inter
subroutine getNewtonDivDiff(xVals,dxVals,fxVals,newtonDivDiff,n)
implicit none
integer ::i,k
integer, intent(in) ::n
real(kind=8), allocatable,dimension(:,:) ::table
real(kind=8),intent(in) ::xVals(0:n),dxVals(0:n),fxVals(0:n)
real(kind=8), intent(inout) ::newtonDivDiff(0:n)
allocate(table(0:n,0:n))
table = 0.0d0
do i=0,n
table(i,0) = fxVals(i)
end do
do k=1,n
do i = k,n
if( k .eq. 1 .and. mod(i,2) .eq. 1) then
table(i,k) = dxVals(i)
else
table(i,k) = (table(i,k-1) - table(i-1,k-1))/(xVals(i) - xVals(i-k))
end if
end do
end do
do i=0,n
newtonDivDiff(i) = table(i,i)
!print*, newtonDivDiff(i)
end do
deallocate(table)
end subroutine getNewtonDivDiff
subroutine evaluatePolynomial(n,newtonDivDiff,x,Px,xVals)
implicit none
integer,intent(in) ::n
real(kind=8),intent(in) ::newtonDivDiff(0:n),xVals(0:n)
real(kind=8),intent(in) ::x
real(kind=8), intent(out) ::Px
integer ::i
Px = newtonDivDiff(n)
do i=n,1,-1
Px = Px * (x- xVals(i-1)) + newtonDivDiff(i-1)
end do
end subroutine evaluatePolynomial
Values
x f(x) f'(x)
1.16, 1.2337, 2.6643
1.32, 1.6879, 2.9989
1.48, 2.1814, 3.1464
1.64, 2.6832, 3.0862
1.8, 3.1553, 2.7697
Output
1.1599999999999999 62.040113431002474
1.3200000000000001 180.40121445431600
1.4800000000000000 212.36319446149312
1.6399999999999999 228.61845650513027
1.8000000000000000 245.11610836104515
You are accessing array newtonDivDiff out of bounds.
You are first allocating it as 0:n (main program's n) then you are passing to subroutine getNewtonDivDiff as 0:n (the subroutine's n) but you pass m (m=n*2+1) to the argument n. That means you tell the subroutine that the array has bounds 0:m which is 0:9, but it has only bounds 0:4.
It is quite difficult to debug the program as it stands, I had to use valgrind. If you move your subroutines to a module and change the dummy arguments to assumed shape arrays (:,:) then the bound checking in gfortran (-fcheck=all) will catch the error.
Other notes:
kind=8 is ugly, 8 can mean different things for different compilers. If you want 64bit variables, you can use kind=real64 (real64 comes from module iso_fortran_env in Fortran 2008) or use selected_real_kind() (Fortran 90 kind parameter)
You do not have to deallocate your local arrays in the subroutines, they are deallocated automatically.
Your deallocate statement in the main program is after the stop statement, it will never be executed. I would just delete the stop, there is no reason to have it.
I have a code in Fortran IV that I need to run. I was told to try to compile it in Fortran 77 and fix the error. So I named the file with a .f extension and tried to compile it with gfortran. I got the next error referring to the Fortran IV function copied below:
abel.f:432.24:
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X)
1
Error: Expected formal argument list in function definition at (1)
Since I'm not too familiar with Fortran I'd appreciate if someone can tell me how to fix this problem .
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X) AAOK0429
C AAOK0430
C THIS SUBROUTINE COMPUTES THE VALUE OF THE DERIVATIVE OF THE AAOK0431
C G-FUNCTION FOR A SLIT TRANSMISSION FUNCTION GIVEN BY A AAOK0432
C PIECE-WISE CUBIC SPLINE , WHOSE PARAMETERS ARE AAOK0433
C CONTAINED IN XNG,FNG AND GNG. AAOK0434
C AAOK0435
IMPLICIT REAL*8(A-H,O-Z) AAOK0436
C AAOK0437
C ALLOWABLE ROUNDING ERROR ON POINTS AT EXTREAMS OF KNOT RANGE AAOK0438
C IS 2**IEPS*MAX(!XNG(1)!,!XNG(NV)!). AAOK0439
INTEGER*4 IFLG/0/,IEPS/-50/ AAOK0440
DIMENSION XNG(1),FNG(1),GNG(1) AAOK0441
C AAOK0442
C TEST WETHER POINT IN RANGE. AAOK0443
IF(X.LT.XNG(1)) GO TO 990 AAOK0444
IF(X.GT.XNG(NV)) GO TO 991 AAOK0445
C AAOK0446
C ESTIMATE KNOT INTERVAL BY ASSUMING EQUALLY SPACED KNOTS. AAOK0447
12 J=DABS(X-XNG(1))/(XNG(NV)-XNG(1))*(NV-1)+1 AAOK0448
C ENSURE CASE X=XNG(NV) GIVES J=NV-1 AAOK0449
J=MIN0(J,NV-1) AAOK0450
C INDICATE THAT KNOT INTERVAL INSIDE RANGE HAS BEEN USED. AAOK0451
IFLG=1 AAOK0452
C SEARCH FOR KNOT INTERVAL CONTAINING X. AAOK0453
IF(X.LT.XNG(J)) GO TO 2 AAOK0454
C LOOP TILL INTERVAL FOUND. AAOK0455
1 J=J+1 AAOK0456
11 IF(X.GT.XNG(J+1)) GO TO 1 AAOK0457
GO TO 7 AAOK0458
2 J=J-1 AAOK0459
IF(X.LT.XNG(J)) GO TO 2 AAOK0460
C AAOK0461
C CALCULATE SPLINE PARAMETERS FOR JTH INTERVAL. AAOK0462
7 H=XNG(J+1)-XNG(J) AAOK0463
Q1=H*GNG(J) AAOK0464
Q2=H*GNG(J+1) AAOK0465
SS=FNG(J+1)-FNG(J) AAOK0466
B=3D0*SS-2D0*Q1-Q2 AAOK0467
A=Q1+Q2-2D0*SS AAOK0468
C AAOK0469
C CALCULATE SPLINE VALUE. AAOK0470
8 Z=(X-XNG(J))/H AAOK0471
C TF=((A*Z+B)*Z+Q1)*Z+FNG(J) AAOK0472
C TG=((3.*A*Z+2.*B)*Z+Q1)/H AAOK0473
C DGDT=(TG-TF/X)/X AAOK0474
DGDT=(3.*A*Z*Z+2.*B*Z+Q1)/H AAOK0475
RETURN AAOK0476
C TEST IF X WITHIN ROUNDING ERROR OF XNG(1). AAOK0477
990 IF(X.LE.XNG(1)-2D0**IEPS*DMAX1(DABS(XNG(1)),DABS(XNG(NV)))) GO AAOK0478
1 TO 99 AAOK0479
J=1 AAOK0480
GO TO 7 AAOK0481
C TEST IF X WITHIN ROUNDING ERROR OF XNG(NV). AAOK0482
991 IF(X.GE.XNG(NV)+2D0**IEPS*DMAX1(DABS(XNG(1)),DABS(XNG(NV)))) GO AAOK0483
1 TO 99 AAOK0484
J=NV-1 AAOK0485
GO TO 7 AAOK0486
99 IFLG=0 AAOK0487
C FUNCTION VALUE SET TO ZERO FOR POINTS OUTSIDE THE RANGE. AAOK0488
DGDT=0D0 AAOK0489
RETURN AAOK0490
END AAOK0491
This doesn't look so bad. Modern compilers still accept the real*8 syntax although it isn't standard. So you should (as mentioned) replace the line
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X) AAOK0429
with
REAL*8 FUNCTION DGDT(IX,NV,XNG,FNG,GNG,X) AAOK0429
which compiled successfully for me using gfortran 4.6.2 using gfortran -c DGDT.f.
Good luck, and be on the lookout for other problems. Just because the code compiles does not mean it is running the same way it was designed!
Not really an answer, see the one from Ross. But I just can't stand the requirement for fixed form. Here is how this code probably would look like in F90 with free form:
function DGDT(IX, NV, XNG, FNG, GNG, X)
! THIS FUNCTION COMPUTES THE VALUE OF THE DERIVATIVE OF THE
! G-FUNCTION FOR A SLIT TRANSMISSION FUNCTION GIVEN BY A
! PIECE-WISE CUBIC SPLINE, WHOSE PARAMETERS ARE
! CONTAINED IN XNG,FNG AND GNG.
implicit none
integer, parameter :: rk = selected_real_kind(15)
integer :: ix, nv
real(kind=rk) :: dgdt
real(kind=rk) :: xng(nv)
real(kind=rk) :: fng(nv)
real(kind=rk) :: gng(nv)
real(kind=rk) :: x
! ALLOWABLE ROUNDING ERROR ON POINTS AT EXTREAMS OF KNOT RANGE
! IS 2**IEPS*MAX(!XNG(1)!,!XNG(NV)!).
integer, parameter :: ieps = -50
integer, save :: iflg = 0
integer :: j
real(kind=rk) :: tolerance
real(kind=rk) :: H
real(kind=rk) :: A, B
real(kind=rk) :: Q1, Q2
real(kind=rk) :: SS
real(kind=rk) :: Z
tolerance = 2.0_rk**IEPS * MAXVAL(ABS(XNG([1,NV])))
! TEST WETHER POINT IN RANGE.
if ((X < XNG(1) - tolerance) .or. (X > XNG(NV) + tolerance)) then
! FUNCTION VALUE SET TO ZERO FOR POINTS OUTSIDE THE RANGE.
iflg = 0
DGDT = 0.0_rk
return
end if
! ESTIMATE KNOT INTERVAL BY ASSUMING EQUALLY SPACED KNOTS.
J = abs(x-xng(1)) / (xng(nv)-xng(1)) * (nv-1) + 1
! ENSURE CASE X=XNG(NV) GIVES J=NV-1
J = MIN(J,NV-1)
! INDICATE THAT KNOT INTERVAL INSIDE RANGE HAS BEEN USED.
IFLG = 1
! SEARCH FOR KNOT INTERVAL CONTAINING X.
do
if ( (x >= xng(j)) .or. (j==1) ) EXIT
j = j-1
! LOOP TILL INTERVAL FOUND.
end do
do
if ( (x <= xng(j+1)) .or. (j==nv-1) ) EXIT
j = j+1
! LOOP TILL INTERVAL FOUND.
end do
! CALCULATE SPLINE PARAMETERS FOR JTH INTERVAL.
H = XNG(J+1) - XNG(J)
Q1 = H*GNG(J)
Q2 = H*GNG(J+1)
SS = FNG(J+1) - FNG(J)
B = 3.0_rk*SS - 2.0_rk*Q1 - Q2
A = Q1 + Q2 - 2.0_rk*SS
! CALCULATE SPLINE VALUE.
Z = (X-XNG(J))/H
DGDT = ( (3.0_rk*A*Z + 2.0_rk*B)*Z + Q1 ) / H
end function DGDT
Note, I did not test this in any way, also there might be some wrong guesses in there, like that ieps should be a constant. Also, I am not so sure about iflg, and the ix argument does not appear to be used at all. So I might got something wrong. For the tolerance it is better to use a factor instead of a difference and a 2.**-50 will not change the value for a the maxval in a double precision number here. Also note, I am using some other F90 features besides the free form now.
DISCLAIMER: Just mentioning a possible solution here, not recommending it...
As much as all other answers are valid and that supporting some Fortran IV code as is is a nightmare, you still might want / need to avoid touching it as much as possible. And since Fortran IV had some strange behaviours when it comes to loops for example (with loops always cycled at least once IINM), using a "proper" Fortran IV compiler might be a "good" idea.
Anyway, all this to say that the Intel compiler for example, supports Fortran IV natively with the -f66 compiler switch, and I'm sure other compilers do as well. This may be worth checking.
I am trying to pass an array of strings from C to a Fortran subroutine as well as from Fortran to that same Fortran subroutine. I have managed to pass single strings (i.e. 1D character arrays) successfully from both C and Fortran. However, I'm having trouble with arrays of strings. I am using ISO C binding on the Fortran side, and ideally I'd like this to be as seamless as possible on the calling side.
I have read some related questions and answers. Some, (i.e. this and this) are simply "Use ISO C" without further details, which doesn't help much. This answer was very helpful (similar answer to a different question), but only works for single strings, where it seems that the c_null_char is recognized in the single Fortran string. I can't figure out what to do for the array case without having two separate routines.
What I currently have is a C routine which I want to pass the array of strings (string) from:
#include <iostream>
extern "C" void print_hi_array(char input_string[][255]);
using namespace std;
int main() {
char string[3][255] = {"asdf","ghji","zxcv"};
print_hi_array(string);
return 0;
}
And, a similar Fortran routine:
program main
implicit none
call print_hi_array( (/"asdf", "ghji", "zxcv"/) )
end program
Thus far, this is what I have for the receiving end:
subroutine print_hi_array(input_string) bind(C)
use iso_c_binding, only: C_CHAR, c_null_char
implicit none
character (kind=c_char, len=1), dimension (3,255), intent (in) :: input_string
character (len=255), dimension (3) :: regular_string
character (len=255) :: dummy_string
integer :: i,j,k
write (*,*) input_string
do j = 1 , 3
dummy_string(:) = c_null_char
k = 1
do i = 1 + (j-1)*255, j*255,1
if (input_string(i) .ne. c_null_char) then
write (*,*) "i ",i,j, input_string(i)
dummy_string(k:k) = input_string(i)
endif
k = k +1
enddo
regular_string(j) = dummy_string
enddo
write (*,*) regular_string
end subroutine print_hi_array
This works for the C function; I get this output:
asdfghjizxcv
j= 1
i 1 1 a
i 2 1 s
i 3 1 d
i 4 1 f
j= 2
i 256 2 g
i 257 2 h
i 258 2 j
i 259 2 i
j= 3
i 511 3 z
i 512 3 x
i 513 3 c
i 514 3 v
asdf ghji zxcv
However, when it's done through Fortran I get nonsense out:
asdfghjizxcv#O,B�#(P,B�]B]6(P,B�# .......
It seems there is no c_null_char in this approach.
So, how can I write a Fortran subroutine to take in arrays of strings from both C and Fortran?
Fortran uses spaces to fill the rest of the string if it is declared longer than its stored text. It is not zero delimited, the declared length is stored in a hidden variable. It does not contain c null char and therefore you are reading some garbage (buffer overflow). What Fortran should print when tlit prints a string with \000 is undefined by the standard and depends on the implementation.
In particular, you are also passing a character(4) array with dimension 3 to a subroutine that expects much more data (255 chars, though I am not shure about the index order). Only pointers are passed so I think it can not be checked.
It is possible to define the length of the strings in the array constructor this way:
[character(255) :: "a","ab","abc"]
I see actually two ways to do that. Either, you write a loop in C and pass the strings one by one to Fortran, as you already did it before. Alternatively, if you want to pass the entire array and you want to handle the Fortran and the C arrays with the same routine, you will have to make an appropriate copy of your C-string array. Below a working, but not too much tested example:
extern "C" void print_array_c(int nstring, char input_string[][255]);
using namespace std;
int main() {
char string[3][255] = {"asdf","ghji","zxcv"};
print_array_c(3, string);
return 0;
}
Please note that I also pass the number of the strings, so that the example can handle arrays with various sizes. (The length of the strings is, however, assumed to be 255 characters.) On the Fortran size, one would need a routine to convert it Fortran strings. One possible visualization could be:
module arrayprint_module
use, intrinsic :: iso_c_binding
implicit none
integer, parameter :: STRLEN = 255
contains
!> The printing routine, works with Fortran character arrays only.
subroutine print_array(strings)
character(len=STRLEN), intent(in) :: strings(:)
integer :: ii
do ii = 1, size(strings)
write(*,*) ii, strings(ii)
end do
end subroutine print_array
!> Converts C string array to Fortran string array and invokes print_array.
subroutine print_array_c(nstring, cptr) bind(C)
integer(c_int), value :: nstring
type(c_ptr), intent(in), value :: cptr
character(kind=c_char), pointer :: fptr(:,:)
character(STRLEN), allocatable :: fstrings(:)
integer :: ii, lenstr
call c_f_pointer(cptr, fptr, [ STRLEN, nstring ])
allocate(fstrings(nstring))
do ii = 1, nstring
lenstr = cstrlen(fptr(:,ii))
fstrings(ii) = transfer(fptr(1:lenstr,ii), fstrings(ii))
end do
call print_array(fstrings)
end subroutine print_array_c
!> Calculates the length of a C string.
function cstrlen(carray) result(res)
character(kind=c_char), intent(in) :: carray(:)
integer :: res
integer :: ii
do ii = 1, size(carray)
if (carray(ii) == c_null_char) then
res = ii - 1
return
end if
end do
res = ii
end function cstrlen
end module arrayprint_module
Please note, that the array you pass from C must be contigous for this to work and I assumed that the character(kind=c_char) is compatible with the fortran character type, which usually it should be.
One approach which I've come up with is to modify the calling Fortran routine to also use ISO C binding:
program main
use iso_c_binding, only: C_CHAR
implicit none
character (kind=c_char, len=255), dimension (3) :: input_string
input_string = (/ "asdf", "ghji", "zxcv" /)
call print_hi_array(input_string)
end program