parent
3fc8a0dc41
commit
8636f31d9c
18 changed files with 149 additions and 121 deletions
@ -1,32 +1,32 @@ |
||||
module gzip |
||||
|
||||
interface |
||||
function gzopen(path, mode) bind(C) |
||||
use iso_c_binding, only: c_char, c_ptr |
||||
implicit none |
||||
character(c_char), intent(in) :: path(*), mode(*) |
||||
type(c_ptr) :: gzopen |
||||
end function gzopen |
||||
end interface |
||||
|
||||
interface |
||||
function gzwrite(file, buf, len) bind(C) |
||||
use iso_c_binding, only: c_int, c_ptr |
||||
implicit none |
||||
type(c_ptr), value, intent(in) :: file |
||||
type(*), intent(in) :: buf |
||||
integer(c_int), value, intent(in) :: len |
||||
integer(c_int) :: gzwrite |
||||
end function gzwrite |
||||
end interface |
||||
|
||||
interface |
||||
function gzclose(file) bind(C) |
||||
use iso_c_binding, only: c_int, c_ptr |
||||
implicit none |
||||
type(c_ptr), value, intent(in) :: file |
||||
integer(c_int) :: gzclose |
||||
end function gzclose |
||||
end interface |
||||
use iso_c_binding, only: c_char, c_ptr, c_int |
||||
implicit none |
||||
|
||||
interface |
||||
type(c_ptr) function gzopen(path, mode) bind(C) |
||||
import c_char, c_ptr |
||||
|
||||
character(kind=c_char), intent(in) :: path(*), mode(*) |
||||
end function gzopen |
||||
end interface |
||||
|
||||
interface |
||||
integer(c_int) function gzwrite(file, buf, len) bind(C) |
||||
import c_int, c_ptr, c_char |
||||
|
||||
type(c_ptr), value, intent(in) :: file |
||||
character(kind=c_char), intent(in) :: buf |
||||
integer(c_int), value, intent(in) :: len |
||||
end function gzwrite |
||||
end interface |
||||
|
||||
interface |
||||
integer(c_int) function gzclose(file) bind(C) |
||||
import c_int, c_ptr |
||||
|
||||
type(c_ptr), value, intent(in) :: file |
||||
end function gzclose |
||||
end interface |
||||
|
||||
end module gzip |
||||
|
@ -1,40 +1,38 @@ |
||||
program main |
||||
|
||||
use iso_c_binding, only: c_int, c_char, c_null_char, c_ptr |
||||
use gzip, only: gzopen, gzwrite, gzclose |
||||
|
||||
implicit none |
||||
|
||||
character(kind=c_char,len=*), parameter :: path = & |
||||
c_char_"test.gz"//c_null_char |
||||
character(kind=c_char,len=*), parameter :: mode = & |
||||
c_char_"wb9"//c_null_char |
||||
integer(c_int), parameter :: buffer_size = 512 |
||||
|
||||
type(c_ptr) :: file |
||||
character(len=buffer_size) :: buffer |
||||
integer(c_int) :: ret |
||||
integer :: i |
||||
|
||||
! open file |
||||
file = gzopen(path, mode) |
||||
|
||||
! fill buffer with data |
||||
do i=1,buffer_size/4 |
||||
write(buffer(4*(i-1)+1:4*i), '(i3.3, a)') i, new_line('') |
||||
end do |
||||
ret = gzwrite(file, buffer, buffer_size) |
||||
if (ret.ne.buffer_size) then |
||||
write(*,'(a, i3, a, i3, a)') 'Error: ', ret, ' / ', buffer_size, & |
||||
' bytes written.' |
||||
stop 1 |
||||
end if |
||||
|
||||
! close file |
||||
ret = gzclose(file) |
||||
if (ret.ne.0) then |
||||
print *, 'Error: failure to close file with error code ', ret |
||||
stop 1 |
||||
end if |
||||
|
||||
end program main |
||||
|
||||
use iso_fortran_env, only: stderr=>error_unit |
||||
use iso_c_binding, only: c_int, c_char, c_null_char, c_ptr |
||||
use gzip, only: gzopen, gzwrite, gzclose |
||||
|
||||
implicit none |
||||
|
||||
character(kind=c_char,len=*), parameter :: path = c_char_"test.gz"//c_null_char |
||||
character(kind=c_char,len=*), parameter :: mode = c_char_"wb9"//c_null_char |
||||
integer(c_int), parameter :: buffer_size = 512 |
||||
|
||||
type(c_ptr) :: file |
||||
character(kind=c_char, len=buffer_size) :: buffer |
||||
integer(c_int) :: ret |
||||
integer :: i |
||||
|
||||
! open file |
||||
file = gzopen(path, mode) |
||||
|
||||
! fill buffer with data |
||||
do i=1,buffer_size/4 |
||||
write(buffer(4*(i-1)+1:4*i), '(i3.3, a)') i, new_line('') |
||||
end do |
||||
ret = gzwrite(file, buffer, buffer_size) |
||||
if (ret /= buffer_size) then |
||||
write(stderr,'(a, i3, a, i3, a)') 'Error: ', ret, ' / ', buffer_size, & |
||||
' bytes written.' |
||||
stop 1 |
||||
end if |
||||
|
||||
! close file |
||||
ret = gzclose(file) |
||||
if (ret /= 0) then |
||||
write(stderr,*) 'Error: failure to close file with error code ', ret |
||||
stop 1 |
||||
end if |
||||
|
||||
end program |
||||
|
@ -1,11 +1,18 @@ |
||||
MODULE Circle |
||||
REAL, PARAMETER :: Pi = 3.1415927 |
||||
MODULE geom |
||||
|
||||
type :: circle |
||||
REAL :: Pi = 4.*atan(1.) |
||||
REAL :: radius |
||||
END MODULE Circle |
||||
end type circle |
||||
END MODULE geom |
||||
|
||||
PROGRAM prog |
||||
|
||||
use Circle |
||||
use geom, only : circle |
||||
IMPLICIT NONE |
||||
|
||||
type(circle) :: ell |
||||
|
||||
ell%radius = 3. |
||||
|
||||
END PROGRAM prog |
||||
|
@ -1,6 +1,6 @@ |
||||
program hello |
||||
use static_hello |
||||
implicit none |
||||
|
||||
call static_say_hello() |
||||
end program hello |
||||
use static_hello |
||||
implicit none |
||||
|
||||
call static_say_hello() |
||||
end program |
||||
|
@ -1,17 +1,17 @@ |
||||
module static_hello |
||||
implicit none |
||||
implicit none |
||||
|
||||
private |
||||
public :: static_say_hello |
||||
private |
||||
public :: static_say_hello |
||||
|
||||
interface static_say_hello |
||||
module procedure say_hello |
||||
end interface static_say_hello |
||||
interface static_say_hello |
||||
module procedure say_hello |
||||
end interface static_say_hello |
||||
|
||||
contains |
||||
|
||||
subroutine say_hello |
||||
print *, "Static library called." |
||||
end subroutine say_hello |
||||
subroutine say_hello |
||||
print *, "Static library called." |
||||
end subroutine say_hello |
||||
|
||||
end module static_hello |
||||
|
@ -1,17 +1,17 @@ |
||||
module dynamic |
||||
implicit none |
||||
implicit none |
||||
|
||||
private |
||||
public :: hello |
||||
private |
||||
public :: hello |
||||
|
||||
interface hello |
||||
module procedure say |
||||
end interface hello |
||||
interface hello |
||||
module procedure say |
||||
end interface hello |
||||
|
||||
contains |
||||
|
||||
subroutine say |
||||
print *, "Hello, hello..." |
||||
end subroutine say |
||||
subroutine say |
||||
print *, "Hello from shared library." |
||||
end subroutine say |
||||
|
||||
end module dynamic |
||||
|
@ -1,6 +1,5 @@ |
||||
program main |
||||
use dynamic |
||||
implicit none |
||||
use dynamic, only: hello |
||||
implicit none |
||||
|
||||
call hello() |
||||
end program main |
||||
call hello() |
||||
end program |
||||
|
@ -1,6 +1,6 @@ |
||||
module MyMod1 |
||||
implicit none |
||||
implicit none |
||||
|
||||
integer, parameter :: myModVal1 = 1 |
||||
integer, parameter :: myModVal1 = 1 |
||||
|
||||
end module MyMod1 |
||||
|
@ -1,6 +1,6 @@ |
||||
module mymod2 |
||||
implicit none |
||||
implicit none |
||||
|
||||
integer, parameter :: myModVal2 = 2 |
||||
integer, parameter :: myModVal2 = 2 |
||||
|
||||
end module mymod2 |
||||
|
@ -1,7 +1,8 @@ |
||||
program test |
||||
use mymod1 |
||||
use MyMod2 |
||||
use mymod1 |
||||
use MyMod2 |
||||
|
||||
integer, parameter :: testVar = myModVal1 + myModVal2 |
||||
implicit none |
||||
|
||||
end program test |
||||
integer, parameter :: testVar = myModVal1 + myModVal2 |
||||
|
||||
end program |
||||
|
@ -1,5 +1,11 @@ |
||||
function fortran() bind(C) |
||||
use, intrinsic :: iso_c_binding |
||||
real(kind=c_double) :: fortran |
||||
fortran = 2.0**rand(1) |
||||
use, intrinsic :: iso_c_binding, only: dp=>c_double |
||||
implicit none |
||||
|
||||
real(dp) :: r, fortran |
||||
|
||||
call random_number(r) |
||||
|
||||
fortran = 2._dp**r |
||||
|
||||
end function fortran |
||||
|
Loading…
Reference in new issue