Topics to Cover:


 

F95 auto deallocation

	...
	! specify that an array "x_ray" is allocatable
        real, allocatable :: x_ray(:)
	...
	...
	! allocate memory for the array
        allocate(x_ray(10))
	! use it
        do i=1,10
                x_ray(i)=i+2
        end do
	! deallocate the array
        deallocate(x_ray)
    

 

F95 auto deallocation


 

F95 auto deallocation - Our example

Source: test1.f90module aptr REAL, POINTER, DIMENSION(:) :: VECTOR => NULL() !real, allocatable,target :: array(:) end module subroutine dummy(i) use aptr !save real, allocatable,target :: x_ray(:) write(*,*) write(*,*)"in dummy vector associated", ASSOCIATED(vector) ! write(*,*)allocated(x_ray) allocate(x_ray(i)) do j=1,i x_ray(j)=j enddo write(*,*)"vector associated", ASSOCIATED(vector), & " vector points to x_ray",ASSOCIATED(vector,x_ray) vector=>x_ray write(*,*)"vector associated", ASSOCIATED(vector), & " vector points to x_ray",ASSOCIATED(vector,x_ray) write(*,*)"sum(vector)",sum(vector),ASSOCIATED(vector) write(*,*) end subroutine program xyz use aptr write(*,*)"in main before first call to dummy" if(associated(vector)) then write(*,*)"sum(vector)",sum(vector),ASSOCIATED(vector) write(*,*)vector else write(*,*)"vector not ASSOCIATED" endif call dummy(5) write(*,*)"back in main after first call to dummy" if(associated(vector)) then write(*,*)"sum(vector)",sum(vector),ASSOCIATED(vector) write(*,*)vector else write(*,*)"vector not ASSOCIATED" endif call dummy(4) write(*,*)"back in main after second call to dummy" if(ASSOCIATED(vector)) then write(*,*)"sum(vector)",sum(vector),ASSOCIATED(vector) write(*,*)vector else write(*,*)"vector not ASSOCIATED" endif end

module aptr
        REAL, POINTER, DIMENSION(:) :: VECTOR => NULL()
        !real, allocatable,target :: array(:)
end module
subroutine dummy(i)
        use aptr
        !save
        real, allocatable,target :: x_ray(:)
        write(*,*)
        write(*,*)"in dummy vector associated", ASSOCIATED(vector)
!        write(*,*)allocated(x_ray)
        allocate(x_ray(i))
        do j=1,i
        x_ray(j)=j
        enddo
        write(*,*)"vector associated", ASSOCIATED(vector), &
                  " vector points to x_ray",ASSOCIATED(vector,x_ray)
        vector=>x_ray
        write(*,*)"vector associated", ASSOCIATED(vector), &
                  " vector points to x_ray",ASSOCIATED(vector,x_ray)
        write(*,*)"sum(vector)",sum(vector),ASSOCIATED(vector)
        write(*,*)
end subroutine
program xyz
        use aptr
        write(*,*)"in main before first call to dummy"
        if(associated(vector)) then
                write(*,*)"sum(vector)",sum(vector),ASSOCIATED(vector)
                write(*,*)vector
        else
                write(*,*)"vector not ASSOCIATED"
        endif
        call dummy(5)
        write(*,*)"back in main after first call to dummy"
        if(associated(vector)) then
                write(*,*)"sum(vector)",sum(vector),ASSOCIATED(vector)
                write(*,*)vector
        else
                write(*,*)"vector not ASSOCIATED"
        endif
        call dummy(4)
        write(*,*)"back in main after second call to dummy"
        if(ASSOCIATED(vector)) then
                write(*,*)"sum(vector)",sum(vector),ASSOCIATED(vector)
                write(*,*)vector
        else
                write(*,*)"vector not ASSOCIATED"
        endif
end




Fortran 90 Complier - xlf90 Fortran 95 Complier - xlf95
 in main before first call to dummy
 vector not ASSOCIATED
 
 in dummy vector associated F
 vector associated F  vector points to x_ray F
 vector associated T  vector points to x_ray T
 sum(vector) 15.00000000 T
 
 back in main after first call to dummy
 sum(vector) 15.00000000 T
 1.000000000 2.000000000 3.000000000 4.000000000 5.000000000
 
 in dummy vector associated T
 vector associated T  vector points to x_ray F
 vector associated T  vector points to x_ray T
 sum(vector) 10.00000000 T
 
 back in main after second call to dummy
 sum(vector) 10.00000000 T
 1.000000000 2.000000000 3.000000000 4.000000000
 
 in main before first call to dummy
 vector not ASSOCIATED
 
 in dummy vector associated F
 vector associated F  vector points to x_ray F
 vector associated T  vector points to x_ray T
 sum(vector) 15.00000000 T
 
 back in main after first call to dummy
 sum(vector) 12.00000000 T
 0.0000000000E+00 0.0000000000E+00 3.000000000 4.000000000 5.000000000
 
 in dummy vector associated T
 vector associated T  vector points to x_ray F
 vector associated T  vector points to x_ray T
 sum(vector) 10.00000000 T
 
 back in main after second call to dummy
 sum(vector) 7.000000000 T
 0.0000000000E+00 0.0000000000E+00 3.000000000 4.000000000
 

 

Our example - comments


 

Stream IO


 

Diversion - linux od command

od -A d -j4 -v -N 64 -t f8 fort.10


 

od example

"View" a file that contains 16 4 byte reals = 4.0

[tkaiser@mio001 tf]$ ls -lt fort.10
-rw-rw-r-- 1 tkaiser tkaiser 64 Jul  6 11:22 fort.10

[tkaiser@mio001 tf]$ cat fort.10
?@?@?@?@?@?@?@?@?@?@?@?@?@?@?@?@[tkaiser@mio001 tf]$ 


[tkaiser@mio001 tf]$ od  -A d -j4 -v -N 64 -t f4 fort.10
0000004   4.000000e+00   4.000000e+00   4.000000e+00   4.000000e+00
0000020   4.000000e+00   4.000000e+00   4.000000e+00   4.000000e+00
0000036   4.000000e+00   4.000000e+00   4.000000e+00   4.000000e+00
0000052   4.000000e+00   4.000000e+00   4.000000e+00
0000064
[tkaiser@mio001 tf]$ od -A d -j4 -v -N 64 -b fort.10
0000004 000 000 200 100 000 000 200 100 000 000 200 100 000 000 200 100
0000020 000 000 200 100 000 000 200 100 000 000 200 100 000 000 200 100
0000036 000 000 200 100 000 000 200 100 000 000 200 100 000 000 200 100
0000052 000 000 200 100 000 000 200 100 000 000 200 100
0000064

"View" a file that contains 4 copies of the string "abcdefghABCDEFGH"

[tkaiser@mio001 tf]$ cat fort.10
abcdefghABCDEFGHabcdefghABCDEFGHabcdefghABCDEFGHabcdefghABCDEFGH[tkaiser@mio001 tf]$ 
[tkaiser@mio001 tf]$ 


[tkaiser@mio001 tf]$ od  -A d -j0 -v -N 64 -c fort.10
0000000   a   b   c   d   e   f   g   h   A   B   C   D   E   F   G   H
0000016   a   b   c   d   e   f   g   h   A   B   C   D   E   F   G   H
0000032   a   b   c   d   e   f   g   h   A   B   C   D   E   F   G   H
0000048   a   b   c   d   e   f   g   h   A   B   C   D   E   F   G   H

 

Our Fortran example

Source: bin.f90 module numz ! module defines the basic real types integer, parameter:: b8 = selected_real_kind(14) integer, parameter:: b4 = selected_real_kind(3) integer, parameter :: in2 = selected_int_kind(1) integer, parameter :: in4 = selected_int_kind(6) integer, parameter :: in8 = selected_int_kind(12) end module function getlen(fname) integer i integer getlen character(len=1) :: a character(*) :: fname open(unit=11,file=trim(fname),form="unformatted",status="old",access="stream") len=0 do read(11,end=1234)a len=len+1 enddo 1234 continue close(11) getlen=len end function program atest use numz integer getlen real(b8) x8(4) real(b4) x4(8) integer(in2) i2(16) integer(in4) i4(8) integer(in8) i8(4) integer wrs,k character (len=8) str8 character (len=16) str16 character (len=1) str1(8) character (len=2) todo(10),indo wrs=0 do while(wrs < 10) read(*,*,end=1234)indo if(indo .eq. "st")goto 1234 wrs=wrs+1 todo(wrs)=indo enddo 1234 continue str8="!@#$%^&*" str16="abcdefghABCDEFGH" str1=(/"1","2","3","4","5","6","7","8"/) !write(*,*)str8 !write(*,*)str16 !write(*,*)str1 i2=(/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/) i4=(/10,20,30,40,50,60,70,80/) i8=(/100,200,300,400/) x8=(/10.,20.,30.,40./) x4=(/1.,2.,3.,4.,5.,6.,7.,8./) open(unit=9,file="fort.9",form="unformatted",status="replace") open(unit=10,file="fort.10",form="unformatted",status="replace",access="stream") do ifile=9,10 do i=1,wrs select case(todo(i)) case ("i2") write(ifile)i2 case ("i4") write(ifile)i4 case ("i8") write(ifile)i8 case ("r4") write(ifile)x4 case ("r8") write(ifile)x8 case ("c1") do k=1,4 write(ifile)str1 enddo case ("c8") do k=1,4 write(ifile)str8 enddo case ("cx") do k=1,2 write(ifile)str16 enddo end select enddo close(ifile) enddo open(unit=9,file="fort.9",form="unformatted",status="old") open(unit=10,file="fort.10",form="unformatted",status="old",access="stream") do ifile=9,10 do i=1,wrs select case(todo(i)) case ("i2") read(ifile)i2 ; write(*,*)i2 case ("i4") read(ifile)i4 ; write(*,*)i4 case ("i8") read(ifile)i8 ; write(*,*)i8 case ("r4") read(ifile)x4 ; write(*,*)x4 case ("r8") read(ifile)x8 ; write(*,*)x8 case ("c1") do k=1,4 read(ifile)str1 enddo write(*,*)str1 case ("c8") do k=1,4 read(ifile)str8 enddo write(*,*)str8 case ("cx") do k=1,2 read(ifile)str16 enddo write(*,*)str16 end select enddo close(ifile) enddo write(*,*) write(*,*)"length fort.10 =",getlen("fort.10") write(*,*)"length fort.9 =",getlen("fort.9") end program

      module numz
! module defines the basic real types
          integer, parameter:: b8 = selected_real_kind(14)
          integer, parameter:: b4 = selected_real_kind(3)
          integer, parameter :: in2 = selected_int_kind(1)
          integer, parameter :: in4 = selected_int_kind(6)
          integer, parameter :: in8 = selected_int_kind(12)
          
      end module
function getlen(fname)
    integer i
    integer getlen
    character(len=1) :: a
    character(*) :: fname
    open(unit=11,file=trim(fname),form="unformatted",status="old",access="stream")
    len=0
    do 
        read(11,end=1234)a
        len=len+1
    enddo
    1234 continue
    close(11)
    getlen=len
end function


program atest
    use numz
    integer getlen
    real(b8) x8(4)
    real(b4) x4(8)
    integer(in2) i2(16)
    integer(in4) i4(8)
    integer(in8) i8(4)
    integer wrs,k
    character (len=8)  str8
    character (len=16) str16
    character (len=1)  str1(8)  
    character (len=2) todo(10),indo
    wrs=0
    do while(wrs < 10)
        read(*,*,end=1234)indo
        if(indo .eq. "st")goto 1234
        wrs=wrs+1
        todo(wrs)=indo
    enddo
1234 continue    
    

    str8="!@#$%^&*"
    str16="abcdefghABCDEFGH"
    str1=(/"1","2","3","4","5","6","7","8"/)
    !write(*,*)str8
    !write(*,*)str16
    !write(*,*)str1

    i2=(/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/)
    i4=(/10,20,30,40,50,60,70,80/)
    i8=(/100,200,300,400/)
    x8=(/10.,20.,30.,40./)
    x4=(/1.,2.,3.,4.,5.,6.,7.,8./)
    open(unit=9,file="fort.9",form="unformatted",status="replace")
    open(unit=10,file="fort.10",form="unformatted",status="replace",access="stream")

        do ifile=9,10
            do i=1,wrs
                select case(todo(i))
                    case ("i2")
                        write(ifile)i2
                    case ("i4")
                        write(ifile)i4
                    case ("i8")
                        write(ifile)i8
                    case ("r4")
                        write(ifile)x4
                    case ("r8")
                        write(ifile)x8
                    case ("c1")
                        do k=1,4
                            write(ifile)str1
                        enddo
                    case ("c8")
                        do k=1,4
                            write(ifile)str8
                        enddo
                    case ("cx")
                        do k=1,2
                            write(ifile)str16
                        enddo
                end select
            enddo
            close(ifile)
        enddo
        open(unit=9,file="fort.9",form="unformatted",status="old")
        open(unit=10,file="fort.10",form="unformatted",status="old",access="stream")
    do ifile=9,10
        do i=1,wrs
            select case(todo(i))
                case ("i2")
                    read(ifile)i2 ; write(*,*)i2
                case ("i4")
                    read(ifile)i4 ; write(*,*)i4
                case ("i8")
                    read(ifile)i8 ; write(*,*)i8
                case ("r4")
                    read(ifile)x4 ; write(*,*)x4
                case ("r8")
                    read(ifile)x8 ; write(*,*)x8
                case ("c1")
                    do k=1,4
                        read(ifile)str1
                    enddo
                    write(*,*)str1
                case ("c8")
                    do k=1,4
                        read(ifile)str8
                    enddo
                    write(*,*)str8
                case ("cx")
                    do k=1,2
                        read(ifile)str16
                    enddo
                    write(*,*)str16
            end select
        enddo
        close(ifile)
    enddo
    write(*,*)
    write(*,*)"length fort.10 =",getlen("fort.10")
    write(*,*)"length fort.9 =",getlen("fort.9")
end program
       
    
    


Opens two unformatted files

        open(unit=9, file="fort.9", form="unformatted",status="replace")
        open(unit=10,file="fort.10",form="unformatted",status="replace",access="stream")

Then...

For this version of the program we get the length by openning the file and read/count character by character


 

Our Fortran example writing 64 bits of real*4 data

[tkaiser@mio001 tf]$ ./a.out
[tkaiser@mio001 tf]$ ./a.out
r4
r4
st
   1.000000       2.000000       3.000000       4.000000       5.000000    
   6.000000       7.000000       8.000000    
   1.000000       2.000000       3.000000       4.000000       5.000000    
   6.000000       7.000000       8.000000    
   1.000000       2.000000       3.000000       4.000000       5.000000    
   6.000000       7.000000       8.000000    
   1.000000       2.000000       3.000000       4.000000       5.000000    
   6.000000       7.000000       8.000000    
 
 length fort.10 =          64
 length fort.9 =          80
[tkaiser@mio001 tf]$ 

[tkaiser@mio001 tf]$ ls -l fort.10 fort.9
-rw-rw-r-- 1 tkaiser tkaiser 32 Jul  6 13:05 fort.10
-rw-rw-r-- 1 tkaiser tkaiser 48 Jul  6 13:05 fort.9
[tkaiser@mio001 tf]$ 

 

Where is the difference in length? od can show us

[tkaiser@mio001 tf]$ ls -l fort.10 fort.9
-rw-rw-r-- 1 tkaiser tkaiser 32 Jul  6 13:05 fort.10
-rw-rw-r-- 1 tkaiser tkaiser 48 Jul  6 13:05 fort.9
[tkaiser@mio001 tf]$ 
[tkaiser@mio001 tf]$ od -A d -v -b fort.10 [tkaiser@mio001 tf]$ od -A d -v -b fort.9

0000000 000 000 200 077 000 000 000 100 000 000 100 100 000 000 200 100
0000016 000 000 240 100 000 000 300 100 000 000 340 100 000 000 000 101
0000032 000 000 200 077 000 000 000 100 000 000 100 100 000 000 200 100
0000048 000 000 240 100 000 000 300 100 000 000 340 100 000 000 000 101
0000064
[tkaiser@mio001 tf]$ 
0000000 040 000 000 000 000 000 200 077 000 000 000 100 000 000 100 100
0000016 000 000 200 100 000 000 240 100 000 000 300 100 000 000 340 100
0000032 000 000 000 101 040 000 000 000 040 000 000 000 000 000 200 077
0000048 000 000 000 100 000 000 100 100 000 000 200 100 000 000 240 100
0000064 000 000 300 100 000 000 340 100 000 000 000 101 040 000 000 000
0000080
[tkaiser@mio001 tf]$ 


[tkaiser@mio001 tf]$ od -A d -v -t f4 fort.10 [tkaiser@mio001 tf]$ od -A d -v -t f4 fort.9
0000000   1.000000e+00   2.000000e+00   3.000000e+00   4.000000e+00
0000016   5.000000e+00   6.000000e+00   7.000000e+00   8.000000e+00
0000032   1.000000e+00   2.000000e+00   3.000000e+00   4.000000e+00
0000048   5.000000e+00   6.000000e+00   7.000000e+00   8.000000e+00
0000064


0000000   4.484155e-44   1.000000e+00   2.000000e+00   3.000000e+00
0000016   4.000000e+00   5.000000e+00   6.000000e+00   7.000000e+00
0000032   8.000000e+00   4.484155e-44   4.484155e-44   1.000000e+00
0000048   2.000000e+00   3.000000e+00   4.000000e+00   5.000000e+00
0000064   6.000000e+00   7.000000e+00   8.000000e+00   4.484155e-44
0000080



Both files contain the same data but the one not opened in "stream" mode has extra "junk"


 

F2003 Fortran and C interoperability

This section "borrows" heavily from:
https://gcc.gnu.org/onlinedocs/gfortran/Interoperability-with-C.html.

Since Fortran 2003 (ISO/IEC 1539-1:2004(E)) there is a standardized way to generate procedure and derived-type declarations and global variables which are interoperable with C (ISO/IEC 9899:1999).

Fortran 2003 adds a data type attribute bind(c), and a module, ISO_C_BINDING which standardizes Fortran/C ISO_C_BINDING.


 

ISO_C_BINDING character constants

NameC definitionValue
C_NULL_CHARnull character'\0'
C_ALERTalert'\a'
C_BACKSPACEbackspace'\b'
C_FORM_FEEDform feed'\f'
C_NEW_LINEnew line'\n'
C_CARRIAGE_RETURNcarriage return'\r'
C_HORIZONTAL_TABhorizontal tab'\t'
C_VERTICAL_TABvertical tab'\v'

We'll see examples of C_NULL_CHAR. It's important.


 

ISO_C_BINDING intrinsic procedures

C_ASSOCIATED
Status of a C pointer
C_ASSOCIATED(c_ptr_1[, c_ptr_2]) determines the status of the C pointer c_ptr_1 or if c_ptr_1 is associated with the target c_ptr_2.
C_F_POINTER
Convert C into Fortran pointer
C_F_POINTER(CPTR, FPTR[, SHAPE]) assigns the target of the C pointer CPTR to the Fortran pointer FPTR and specifies its shape.
C_F_PROCPOINTER
Convert C into Fortran procedure pointer
C_F_PROCPOINTER(CPTR, FPTR) Assign the target of the C function pointer CPTR to the Fortran procedure pointer FPTR.
C_FUNLOC
Obtain the C address of a procedure
C_FUNLOC(x) determines the C address of the argument.
C_LOC
C_LOC — Obtain the C address of an object
C_LOC(X) determines the C address of the argument.
C_SIZEOF
C_SIZEOF — Size in bytes of an expression
C_SIZEOF(X) calculates the number of bytes of storage the expression X occupies.

We'll look at C_LOC, C_F_POINTER and C_ASSOCIATED


 

ISO_C_BINDING Fortran data types

The Fortran data types "map" to C types. If you want to use a variable in both Fortran and C it should be declared as one of thes types in Fortran.

Fortran TypeNamed constantC type
INTEGERC_INTint
INTEGERC_SHORTshort int
INTEGERC_LONGlong int
INTEGERC_LONG_LONGlong long int
INTEGERC_SIGNED_CHARsigned char/unsigned char
INTEGERC_SIZE_Tsize_t
INTEGERC_INT8_Tint8_t
INTEGERC_INT16_Tint16_t
INTEGERC_INT32_Tint32_t
INTEGERC_INT64_Tint64_t
INTEGERC_INT_LEAST8_Tint_least8_t
INTEGERC_INT_LEAST16_Tint_least16_t
INTEGERC_INT_LEAST32_Tint_least32_t
INTEGERC_INT_LEAST64_Tint_least64_t
INTEGERC_INT_FAST8_Tint_fast8_t
INTEGERC_INT_FAST16_Tint_fast16_t
INTEGERC_INT_FAST32_Tint_fast32_t
INTEGERC_INT_FAST64_Tint_fast64_t
INTEGERC_INTMAX_Tintmax_t
INTEGERC_INTPTR_Tintptr_t
REALC_FLOATfloat
REALC_DOUBLEdouble
REALC_LONG_DOUBLElong double
COMPLEXC_FLOAT_COMPLEXfloat _Complex
COMPLEXC_DOUBLE_COMPLEXdouble _Complex
COMPLEXC_LONG_DOUBLE_COMPLEXlong double _Complex
LOGICALC_BOOL_Bool
CHARACTERC_CHARchar

 

Our First Example - call a C routine to get file length

    write(*,*)"length fort.10 =",getlen_c("fort.10")
    write(*,*)"length fort.9 =",getlen_c("fort.9")

C Routine:

Source: getit.c#include #include #include #include size_t c_filesize(char* filename) { size_t rv = 0; // Return 0, if failure struct stat file_info; if ( (filename != NULL) && (stat(filename,&file_info) == 0) ) //NULL check/stat() call rv = (size_t)file_info.st_size; // Note: this may not fit in a size_t variable return rv; }


#include 
#include 
#include 
#include 
size_t c_filesize(char* filename)
{
    size_t rv = 0;  // Return 0, if failure
    struct stat  file_info;

    if ( (filename != NULL) && (stat(filename,&file_info) == 0) )  //NULL check/stat() call
      rv = (size_t)file_info.st_size;  // Note: this may not fit in a size_t variable

  return rv;
}



module getit
contains
function getlen_c(fname)
    USE ISO_C_BINDING, ONLY: c_long, c_char,C_NULL_CHAR
    use numz
    integer(in8) :: getlen_c
    interface 
        integer(c_long) function filesize(aname) BIND(C, NAME='c_filesize')
          USE ISO_C_BINDING, ONLY: c_long, c_char
          character(kind=c_char) :: aname(*)
        end function fileSize
    end interface
    character(*) :: fname
    character(128) :: tmp
    character(kind=c_char) :: string(128)
    integer strlen
    ! fill the string with nulls (strings for c must be null terminated)
    string=C_NULL_CHAR
    ! copy our input string to a c_char string
    tmp=trim(ADJUSTL(fname))
    strlen=len_trim(tmp)
    do i=1,strlen
        string(i:i)=tmp(i:i)
    enddo
    getlen_c=fileSize(string)
end function
end module


Our Function getlen_c takes a file name and returns a file length.

ISO_C_BINDING contains our Fortran equivalent data types. Here we are going to define variables that have typed matching C long and C char. We are also going to use the C null character.

Our function returns an integer of type "in8". In8 is defined in "numz" to be an 8 byte integer.

Next we have the interface for our C routine. It will return a C long and take a C character array.

The BIND clause first "just" says that this is a C routine. If you have ever written mixed language programs you will appreciate the NAME='c_filesize' clause. What this does is specify the name of the routine in C. Why is this important. Previously, if you wrote a mixed language program the Fortran compiler may or may not append and underscore (_) to the end of the routine name. So on the C side you would need to be able to compile with or without the underscore. Here we are forcing the Fortran compiler to name our C function as given.

The string we are sending to the C routine is defined here.

We are going to fill it with NULLs. This is a bit of an overkill. Only the character after our filename needs to be NULL.

Next we "unpad" our input string and copy it to our C string.

Finally we call the C routine.


 

Our Second Example - Fortran calls C and C calls Fortran

Source: fandc.f90 - moduleMODULE FTN_C INTERFACE ! int C_Library_Function(float* sendbuf, int sendcount, float *recvcounts, float *mysum) INTEGER (C_INT) FUNCTION C_LIBRARY_FUNCTION (SENDBUF, SENDCOUNT, RECV, mysum) & BIND(C, NAME='C_Library_Function') USE ISO_C_BINDING IMPLICIT NONE TYPE (C_PTR), VALUE :: SENDBUF INTEGER (C_INT), VALUE :: SENDCOUNT Real (C_FLOAT) :: mysum TYPE (C_PTR), VALUE :: RECV END FUNCTION C_LIBRARY_FUNCTION END INTERFACE INTERFACE subroutine c_dosim ( ) BIND(C, NAME='do_sim') USE ISO_C_BINDING IMPLICIT NONE END subroutine c_dosim END INTERFACE END MODULE FTN_C
Source: fandc.f90 - main program backforth USE ISO_C_BINDING, ONLY: C_INT, C_FLOAT, C_LOC USE FTN_C REAL (C_FLOAT), TARGET :: SEND(10) INTEGER (C_INT) :: SENDCOUNT Real (C_FLOAT) :: mysum REAL (C_FLOAT), ALLOCATABLE, TARGET :: RECV(:) SENDCOUNT=size(SEND) do i=1,SENDCOUNT SEND(i)=i enddo ALLOCATE( RECV(SENDCOUNT) ) mysum=-1.0 write(*,'("Fortran mysum before C call = ",f7.1)'),mysum i=C_LIBRARY_FUNCTION(C_LOC(SEND), SENDCOUNT, C_LOC(RECV),mysum) write(*,'("Back from C in Fortran mysum = ",f7.1)'),mysum do i=1,SENDCOUNT write(*,*)send(i),recv(i) enddo write(*,'("Fortran calling C again")') call c_dosim() end program
Source: fandc.f90 - subroutineSUBROUTINE SIMULATION(ALPHA, BETA, GAMMA, DELTA, ARRAYS) BIND(C ,NAME='f_routine') USE ISO_C_BINDING IMPLICIT NONE INTEGER (C_LONG), VALUE :: alpha REAL (C_DOUBLE), INTENT(INOUT) :: beta REAL (C_DOUBLE), INTENT(OUT) :: gamma REAL (C_DOUBLE),DIMENSION(*),INTENT(IN) :: DELTA TYPE, BIND(C) :: PASS INTEGER (C_INT) :: LENC, LENF TYPE (C_PTR) :: C, F END TYPE PASS TYPE (PASS), INTENT(INOUT) :: ARRAYS REAL (C_FLOAT), ALLOCATABLE, TARGET, SAVE :: ETA(:) REAL (C_FLOAT), POINTER :: C_ARRAY(:) integer i,j write(*,'("In Fortran called from C alpha=",i4,& " beta=",f10.2," gamma=",f10.2)')& alpha,beta,gamma gamma=0.0 do i=1,alpha gamma=gamma+beta*delta(i) enddo beta=1234.0 !... write(*,*)"! Associate C_ARRAY with an array allocated in C" CALL C_F_POINTER (ARRAYS%C, C_ARRAY, (/ARRAYS%LENC/) ) if(c_associated(ARRAYS%C, c_loc(C_ARRAY)))then write(*,*)'ARRAYS%C, C_ARRAY point to same target' else write(*,*)'ARRAYS%C, C_ARRAY do not point to same target' stop endif !... write(*,*)"! Allocate an array and make it available in C" ARRAYS%LENF = 100 ALLOCATE (ETA(ARRAYS%LENF)) ARRAYS%F = C_LOC(ETA) j=min(ARRAYS%lenc,ARRAYS%lenf) write(*,*)"Fortan fills the array for C" do i=1,j ETA(i)=C_ARRAY(i)*2 enddo END SUBROUTINE SIMULATION

MODULE FTN_C 
INTERFACE
! int C_Library_Function(float* sendbuf, int sendcount, float *recvcounts, float *mysum)
INTEGER (C_INT) FUNCTION C_LIBRARY_FUNCTION (SENDBUF, SENDCOUNT, RECV, mysum) &
                BIND(C, NAME='C_Library_Function')
    USE ISO_C_BINDING
    IMPLICIT NONE
    TYPE (C_PTR), VALUE :: SENDBUF 
    INTEGER (C_INT), VALUE :: SENDCOUNT 
     Real (C_FLOAT) :: mysum
    TYPE (C_PTR), VALUE :: RECV
    END FUNCTION C_LIBRARY_FUNCTION 
END INTERFACE
INTERFACE
subroutine c_dosim ( ) BIND(C, NAME='do_sim')
    USE ISO_C_BINDING
    IMPLICIT NONE
    END subroutine c_dosim 
END INTERFACE
END MODULE FTN_C

SUBROUTINE SIMULATION(ALPHA, BETA, GAMMA, DELTA, ARRAYS) BIND(C ,NAME='f_routine')
    USE ISO_C_BINDING
    IMPLICIT NONE
    INTEGER (C_LONG), VALUE :: alpha
    REAL (C_DOUBLE), INTENT(INOUT) :: beta
    REAL (C_DOUBLE), INTENT(OUT) :: gamma
    REAL (C_DOUBLE),DIMENSION(*),INTENT(IN) :: DELTA 
    TYPE, BIND(C) :: PASS
        INTEGER (C_INT) :: LENC, LENF
        TYPE (C_PTR) :: C, F 
    END TYPE PASS
    TYPE (PASS), INTENT(INOUT) :: ARRAYS
    REAL (C_FLOAT), ALLOCATABLE, TARGET, SAVE :: ETA(:) 
    REAL (C_FLOAT), POINTER :: C_ARRAY(:)
    integer i,j
    write(*,'("In Fortran called from C alpha=",i4,&
              " beta=",f10.2," gamma=",f10.2)')&
            alpha,beta,gamma
    gamma=0.0
    do i=1,alpha
        gamma=gamma+beta*delta(i)
    enddo
    beta=1234.0
    
    !...
    write(*,*)"! Associate C_ARRAY with an array allocated in C"
    CALL C_F_POINTER (ARRAYS%C, C_ARRAY, (/ARRAYS%LENC/) ) 
    if(c_associated(ARRAYS%C, c_loc(C_ARRAY)))then
        write(*,*)'ARRAYS%C, C_ARRAY point to same target'
    else
        write(*,*)'ARRAYS%C, C_ARRAY do not point to same target'
        stop
    endif
    !...
    write(*,*)"! Allocate an array and make it available in C" 
    ARRAYS%LENF = 100
    ALLOCATE (ETA(ARRAYS%LENF))
    ARRAYS%F = C_LOC(ETA)
    j=min(ARRAYS%lenc,ARRAYS%lenf)
    write(*,*)"Fortan fills the array for C"
    do i=1,j
        ETA(i)=C_ARRAY(i)*2
    enddo
END SUBROUTINE SIMULATION

program backforth
    USE ISO_C_BINDING, ONLY: C_INT, C_FLOAT, C_LOC 
    USE FTN_C
    REAL (C_FLOAT), TARGET :: SEND(10)
    INTEGER (C_INT) :: SENDCOUNT
    Real (C_FLOAT) :: mysum
    REAL (C_FLOAT), ALLOCATABLE, TARGET :: RECV(:)

    SENDCOUNT=size(SEND)
    do i=1,SENDCOUNT
        SEND(i)=i
    enddo
    ALLOCATE( RECV(SENDCOUNT) )
    mysum=-1.0
    write(*,'("Fortran mysum before C call  = ",f7.1)'),mysum
    i=C_LIBRARY_FUNCTION(C_LOC(SEND), SENDCOUNT, C_LOC(RECV),mysum)
    write(*,'("Back from C in Fortran mysum = ",f7.1)'),mysum

    do i=1,SENDCOUNT
        write(*,*)send(i),recv(i)
    enddo
    write(*,'("Fortran calling C again")')
    call c_dosim()
end program


 

Our Main Routine

program backforth
    USE ISO_C_BINDING, ONLY: C_INT, C_FLOAT, C_LOC 
    USE FTN_C
    REAL (C_FLOAT), TARGET :: SEND(10)
    INTEGER (C_INT) :: SENDCOUNT
    Real (C_FLOAT) :: mysum
    REAL (C_FLOAT), ALLOCATABLE, TARGET :: RECV(:)

    SENDCOUNT=size(SEND)
    do i=1,SENDCOUNT
        SEND(i)=i
    enddo
    ALLOCATE( RECV(SENDCOUNT) )
    mysum=-1.0
    write(*,'("Fortran mysum before C call  = ",f7.1)'),mysum
    i=C_LIBRARY_FUNCTION(C_LOC(SEND), SENDCOUNT, C_LOC(RECV),mysum)
    write(*,'("Back from C in Fortran mysum = ",f7.1)'),mysum

    do i=1,SENDCOUNT
        write(*,*)send(i),recv(i)
    enddo
    write(*,'("Fortran calling C again")')
    call c_dosim()
end program

We will use C ints and floats in this program as well as the C_LOC function so there are included here.

We will be sending a regular array which we fill. We allocate an array that will have data put in it in the C procedure.

MYSUM will also be modified in the c routine. SENDCOUNT will not be changed.

Using C_LOC is a bit odd in my opinion. SEND and RECV are arrays but we will be sending the arrays as pointers. C_LOC gives the pointer address.

We next look at the interface for C_LIBRARY_FUNCTION. Before that we note that after the call to C_LIBRARY_FUNCTION we print our returned data.


 

Our Interface

MODULE FTN_C 
INTERFACE
! int C_Library_Function(float* sendbuf, int sendcount, float *recvcounts, float *mysum)
INTEGER (C_INT) FUNCTION C_LIBRARY_FUNCTION (SENDBUF, SENDCOUNT, RECV, mysum) &
                BIND(C, NAME='C_Library_Function')
    USE ISO_C_BINDING
    IMPLICIT NONE
    TYPE (C_PTR), VALUE :: SENDBUF 
    INTEGER (C_INT), VALUE :: SENDCOUNT 
     Real (C_FLOAT) :: mysum
    TYPE (C_PTR), VALUE :: RECV
    END FUNCTION C_LIBRARY_FUNCTION 
END INTERFACE
INTERFACE
subroutine c_dosim ( ) BIND(C, NAME='do_sim')
    USE ISO_C_BINDING
    IMPLICIT NONE
    END subroutine c_dosim 
END INTERFACE
END MODULE FTN_C


We include the C interface for the routine as a reference.

In the interface we declare the SENDBUF and RECV as pointers. So this matches what we did in the program. Note that we are sending these by VALUE, which is normal for C. We can do this because we are not changing the value of the pointer.

SENDCOUNT will not change either so we send by value.

MYSUM will be changed in the C routine. It is sent by location. Note in the C routine it will be dereferenced as indicated in the C interface.




 

Now we look at the C routine called by Fortran

Source: cpart_1.c#include #include #include /* this routine is called by fortran */ int C_Library_Function(float* sendbuf, int sendcount, float *recvcounts, float *mysum) { int i; float pi=3.1415926; printf("In C mysum before loop =%g\n",*mysum); *mysum=0.0; for(i=0;i

#include 
#include 
#include 
/* this routine is called by fortran */
int C_Library_Function(float* sendbuf, int sendcount, float *recvcounts, float *mysum) {
int i;
float pi=3.1415926;
printf("In C mysum before loop =%g\n",*mysum);
*mysum=0.0;

for(i=0;i

The Routine just takes the input array and put sin in the output array and sums into *mysum.

The cool thing about this routine is that there is nothing special about it.

Note: sendbuf, recvcounts, are pointers / arrays. We are passing back mysum so it also needs to be a pointer. Finally sendcount is not a pointer because it is not changed.


 

Here is a C routine that will call Fortran

Source: cpart_2.c#include #include struct pass {int lenc, lenf; float *c, *f;}; void f_routine(long alpha, double *beta, double *gamma, double delta[], struct pass *arrays); /* this routine is called by fortran but it also calls a fortran routine "simulation" */ void do_sim(){ struct pass arrays; long alpha; double beta; double gamma; double *delta; int i; printf("C in do_sim\n"); alpha=10; delta=(double*)malloc(alpha*sizeof(double)); beta=0.5; gamma=0; for (i=0;i

#include 
#include 
struct pass {int lenc, lenf; float *c,  *f;};

void f_routine(long alpha, double *beta, double *gamma, double delta[], struct pass *arrays);

/* this routine is called by fortran but it
   also calls a fortran routine "simulation"
*/
void do_sim(){ 
	struct pass arrays;
	long alpha;
	double beta;
	double gamma;
	double *delta;
	int i;
	printf("C in do_sim\n");	
	alpha=10;
	delta=(double*)malloc(alpha*sizeof(double));
	beta=0.5;
	gamma=0;
	for (i=0;i

We have a data structure that will have a match in Fortran

This interface statement is for our Fortran Routine

We set alpha, beta, gamma, allocate delta and fill it.

The "len" portions of our data structure are assigned.

We allocate arrays.c and fill it but we don't allocate arrays.f

We call our Fortran routine.

On return from Fortran beta and gamma have been changed and arrays.f has been allocated and filled.


 

Finally... we have our Fortran called by C

Source: simulation.f90SUBROUTINE SIMULATION(ALPHA, BETA, GAMMA, DELTA, ARRAYS) BIND(C ,NAME='f_routine') USE ISO_C_BINDING IMPLICIT NONE INTEGER (C_LONG), VALUE :: alpha REAL (C_DOUBLE), INTENT(INOUT) :: beta REAL (C_DOUBLE), INTENT(OUT) :: gamma REAL (C_DOUBLE),DIMENSION(*),INTENT(IN) :: DELTA TYPE, BIND(C) :: PASS INTEGER (C_INT) :: LENC, LENF TYPE (C_PTR) :: C, F END TYPE PASS TYPE (PASS), INTENT(INOUT) :: ARRAYS REAL (C_FLOAT), ALLOCATABLE, TARGET, SAVE :: ETA(:) REAL (C_FLOAT), POINTER :: C_ARRAY(:) integer i,j write(*,'("In Fortran called from C alpha=",i4,& " beta=",f10.2," gamma=",f10.2)')& alpha,beta,gamma gamma=0.0 do i=1,alpha gamma=gamma+beta*delta(i) enddo beta=1234.0 !... write(*,*)"! Associate C_ARRAY with an array allocated in C" CALL C_F_POINTER (ARRAYS%C, C_ARRAY, (/ARRAYS%LENC/) ) if(c_associated(ARRAYS%C, c_loc(C_ARRAY)))then write(*,*)'ARRAYS%C, C_ARRAY point to same target' else write(*,*)'ARRAYS%C, C_ARRAY do not point to same target' stop endif !... write(*,*)"! Allocate an array and make it available in C" ARRAYS%LENF = 100 ALLOCATE (ETA(ARRAYS%LENF)) ARRAYS%F = C_LOC(ETA) j=min(ARRAYS%lenc,ARRAYS%lenf) write(*,*)"Fortan fills the array for C" do i=1,j ETA(i)=C_ARRAY(i)*2 enddo END SUBROUTINE SIMULATION

SUBROUTINE SIMULATION(ALPHA, BETA, GAMMA, DELTA, ARRAYS) BIND(C ,NAME='f_routine')
    USE ISO_C_BINDING
    IMPLICIT NONE
    INTEGER (C_LONG), VALUE :: alpha
    REAL (C_DOUBLE), INTENT(INOUT) :: beta
    REAL (C_DOUBLE), INTENT(OUT) :: gamma
    REAL (C_DOUBLE),DIMENSION(*),INTENT(IN) :: DELTA 
    TYPE, BIND(C) :: PASS
        INTEGER (C_INT) :: LENC, LENF
        TYPE (C_PTR) :: C, F 
    END TYPE PASS
    TYPE (PASS), INTENT(INOUT) :: ARRAYS
    REAL (C_FLOAT), ALLOCATABLE, TARGET, SAVE :: ETA(:) 
    REAL (C_FLOAT), POINTER :: C_ARRAY(:)
    integer i,j
    write(*,'("In Fortran called from C alpha=",i4,&
              " beta=",f10.2," gamma=",f10.2)')&
            alpha,beta,gamma
    gamma=0.0
    do i=1,alpha
        gamma=gamma+beta*delta(i)
    enddo
    beta=1234.0
    
    !...
    write(*,*)"! Associate C_ARRAY with an array allocated in C"
    CALL C_F_POINTER (ARRAYS%C, C_ARRAY, (/ARRAYS%LENC/) ) 
    if(c_associated(ARRAYS%C, c_loc(C_ARRAY)))then
        write(*,*)'ARRAYS%C, C_ARRAY point to same target'
    else
        write(*,*)'ARRAYS%C, C_ARRAY do not point to same target'
        stop
    endif
    !...
    write(*,*)"! Allocate an array and make it available in C" 
    ARRAYS%LENF = 100
    ALLOCATE (ETA(ARRAYS%LENF))
    ARRAYS%F = C_LOC(ETA)
    j=min(ARRAYS%lenc,ARRAYS%lenf)
    write(*,*)"Fortan fills the array for C"
    do i=1,j
        ETA(i)=C_ARRAY(i)*2
    enddo
END SUBROUTINE SIMULATION


The subroutine statement says that this routine can be called from C with the name f_routine

Alpha is passed by value as indicated by the attribute.

Beta has intent inout and gamma out. Both could have been given intent inout since they are passed as pointers.

Next we have our data structure arrays having the type pass matching the C pass structure.

We finally have eta and c_array which will be mapped to arrays in the C world.

We are changing beta and gamma. These changed values gets printed in C.

We are passing in our data structure which contains ARRAYS%C. We show here haw we can use C_F_POINTER to set a pointer to that. Then we call c_associated to check that this worked.

Next we show how we can allocate an array in Fortran "ETA" and then assign its memory to the array originally from C. This is done indirectly, we don't allocate the C variable. The reason for this is related to what we talked about earlier. The array could be automatically deallocated on routine exit. Here we give "ETA" the save attribute to prevent that.


 

The Results...

Source: results2In C mysum before loop =-1 In C mysum after loop = 4.5 C in do_sim Fortran mysum before C call = -1.0 Back from C in Fortran mysum = 4.5 1.00000000 0.00000000 2.00000000 0.642787576 3.00000000 0.984807730 4.00000000 0.866025448 5.00000000 0.342020273 6.00000000 -0.342019975 7.00000000 -0.866025329 8.00000000 -0.984807789 9.00000000 -0.642787814 10.0000000 -3.01991605E-07 Fortran calling C again In Fortran called from C alpha= 10 beta= 0.50 gamma= 0.00 ! Associate C_ARRAY with an array allocated in C ARRAYS%C, C_ARRAY point to same target ! Allocate an array and make it available in C Fortan fills the array for C C back in do_sim beta = 1234 gamma=2250 0 0 1 2 2 4 3 6 4 8 5 10 6 12 7 14 8 16 9 18

In C mysum before loop =-1
In C mysum after loop  = 4.5
C in do_sim
Fortran mysum before C call  =    -1.0
Back from C in Fortran mysum =     4.5
   1.00000000       0.00000000    
   2.00000000      0.642787576    
   3.00000000      0.984807730    
   4.00000000      0.866025448    
   5.00000000      0.342020273    
   6.00000000     -0.342019975    
   7.00000000     -0.866025329    
   8.00000000     -0.984807789    
   9.00000000     -0.642787814    
   10.0000000      -3.01991605E-07
Fortran calling C again
In Fortran called from C alpha=  10 beta=      0.50 gamma=      0.00
 ! Associate C_ARRAY with an array allocated in C
 ARRAYS%C, C_ARRAY point to same target
 ! Allocate an array and make it available in C
 Fortan fills the array for C
C back in do_sim
beta = 1234 gamma=2250
0 0
1 2
2 4
3 6
4 8
5 10
6 12
7 14
8 16
9 18


 

Forall statement

Fortran 95 provides an efficient alternative to the element by element construction of an array value in Fortran 90.

Interpreting the FORALL Statement

  1. Evaluate the subscript and stride expressions for each forall_triplet_spec in any order. All possible pairings of index_name values form the set of combinations. For example, given the following statement:
  2. Evaluate the scalar_mask_expr for the set of combinations, in any order, producing a set of active combinations (those for which scalar_mask_expr evaluated to .TRUE.). For example, if the mask (I+J.NE.6) is applied to the above set, the set of active combinations is:
  3. For assignment_statement, evaluate, in any order, all values in the right-hand side expression and all subscripts, strides, and substring bounds in the left-hand side variable for all active combinations of index_name values.
  4. For assignment_statement, assign, in any order, the computed expression values to the corresponding variable entities for all active combinations of index_name values.
Fortran 90 nested Do Similar Fortran 95 Forall
    do j=j1,j2
        do i=i1,i2
            new_psi(i,j)=a1*psi(i+1,j) + a2*psi(i-1,j) + &
                         a3*psi(i,j+1) + a4*psi(i,j-1) - &
                         a5*for(i,j)
         enddo
     enddo
    psi(i1:i2,j1:j2)=new_psi(i1:i2,j1:j2)		
		
    FORALL (i=i1:i2, j=j1:j2)
            psi(i,j)=a1*psi(i+1,j) + a2*psi(i-1,j) + &
                         a3*psi(i,j+1) + a4*psi(i,j-1) - &
                         a5*for(i,j)
    end forall
		
run time = 7.08 (75,000 iterations) run time = 6.58 (75,000 iterations)

 

Object-oriented programming (OOP) in Fortran...

object-oriented programming...

Fortran Support in 33 seconds or less


 

Really good source for more information

Fortan Wiki Object-oriented programming
http://fortranwiki.org/fortran/show/Object-oriented+programming
Object-Oriented Programming in Fortran 2003 Part 1: Code Reusability
https://www.pgroup.com/lit/articles/insider/v3n1a3.htm
Object-Oriented Programming in Fortran 2003 Part 2: Data Polymorphism
https://www.pgroup.com/lit/articles/insider/v3n2a2.htm
Object-Oriented Programming in Fortran 2003 Part 3: Parameterized Derived Types
https://www.pgroup.com/lit/articles/insider/v5n2a4.htm
Object-Oriented Programming in Fortran 2003 Part 4: User-Defined Derived Type Input/Output
https://www.pgroup.com/lit/articles/insider/v6n2a3.htm

 

A cool example from above

Source: list.f90 - moduleClick to open this file in a new window.
Source: link.f90 - moduleClick to open this file in a new window.
Source: ll.f90 - moduleClick to open this file in a new window.

Creates a linked list with different data types for values

Source Output
program main
  use list_mod
  implicit none
  integer i
  type(list) :: my_list

  do i=1, 10
     call my_list%add(i)
  enddo
  call my_list%add(1.23)
  call my_list%add('A')
  call my_list%add('B')
  call my_list%add('C')
  call my_list%printvalues()
end program main


           1
           2
           3
           4
           5
           6
           7
           8
           9
          10
   1.23000002    
 A
 B
 C