how to convert a gchar to a fortran character? - fortran

I am using the combo box with text in GTK fortran in VS community 2019 solution. I am trying to get the string selected with "gtk_combo_box_text_get_active_text" and c_f_pointer to convert the gchar back to fortran character. It will work fine if something is selected and not null. When it is null I will receive a crash as follows:
crash
I guess this is because the pointer is pointing to null and cannot be accessed, but it would be best if I can also detect nothing is selected.
Thus, I would like to ask if there is a better and also simple way to convert the gchar to fortran character OR a way to detect it being null without crashing it. Thank you everyone!
These are the code I am dealing with:
botMain_systemChoosing = gtk_combo_box_text_new()
call gtk_container_add(bottomPanel_Main,botMain_systemChoosing)
call gtk_combo_box_text_append(botMain_systemChoosing,"1","system 1")
call gtk_combo_box_text_append(botMain_systemChoosing,"2","system 2")
call gtk_widget_show(botMain_systemChoosing)
.....
type(c_ptr) :: currentSys
character(len=8),pointer :: string
currentSys = gtk_combo_box_text_get_active_text(botMain_systemChoosing)
call c_f_pointer(currentSys,string)
if (string == "system 1") then
print*, "1"
else
print*, "default"
end if
EDIT solution#1:
use, intrinsic :: iso_c_binding, only: c_ptr,c_associated
type(c_ptr) :: currentSys
character(len=8),pointer :: string
// returns a gchar
currentSys = gtk_combo_box_text_get_active_text(botMain_systemChoosing)
call c_f_pointer(currentSys,string)
if (.not. c_associated(currentSys)) then
print*, "null"
elseif (string == "system 1") then
print*, "1"
else
print*, "default"
end if

I don’t have experience with gtk-fortran, but I guess you should just check that the pointer is associated:
if (.not.associated(string)) then
print*, “null”
elseif (string == "system 1") then
print*, "1"
else
print*, "default"
end if
See this example:
program test_ptr
use iso_c_binding
implicit none
type(c_ptr) :: c = c_null_ptr
character(kind=c_char,len=1), pointer :: s(:)
call c_f_pointer(c,s,[10])
print *, 'fortran associated = ',associated(s),' c associated=',c_associated(c)
end program
it prints
fortran associated = F c associated= F

Related

Is there a function that removes all nonalphanumeric numbers in Fortran?

New to Fortran,been trying to think of a function that replaces all non alphanumeric characters and spaces on a string so that it turns something like [AS:1] to AS1.
Anyone here got a clue how to?
Like I got a trimmer for open spaces to work but I don't know how to make it work for anything that's a non-alphanumeric character.
The intrinsic function SCANcan be used for membership searches.
If we have a character char of length-1 and a set set of non-zero size, then we have that SCAN(char, set) returns 1 (0) if char is in (not in) the set. (SCAN will return 0 if the set is of size zero.)
This functions is elemental so, for example, SCAN(char_array, set) returns an indicator for which elements of char_array are in the set.
We also have PACK which returns another array corresponding to a selection mask:
print*, PACK(char_array, SCAN(char_array,set).eq.1)
Which means we can write a subroutine like
subroutine s(in, out, keep, len)
integer, intent(in) :: len
character, intent(in) :: in(len), keep*(*)
character, intent(out) :: out(len)
integer :: i
out = PACK(in, SCAN(in,keep).eq.1, [(' ',i=1,len)])
end subroutine s
taking an input character array of size len and returning an output character array of the same size with the elements which are in keep (and trailing elements being blanks).
Naturally, we don't like working with character arrays instead of scalars, so let's provide a nice subroutine using sequence association:
subroutine strip(in, out, keep)
character(*), intent(in) :: in, keep
character(*), intent(out) :: out
call s(in, out, keep, LEN(in))
end subroutine
Complete example:
module stripping
implicit none
private s
contains
subroutine strip(in, out, keep)
character(*), intent(in) :: in, keep
character(*), intent(out) :: out
call s(in, out, keep, len(in))
end subroutine strip
subroutine s(in, out, keep, len)
integer, intent(in) :: len
character, intent(in) :: in(len), keep*(*)
character, intent(out) :: out(len)
integer :: i
out = PACK(in, SCAN(in,keep).eq.1, [(' ',i=1,len)])
end subroutine s
end module stripping
program test
use stripping, only : strip
implicit none
character(10) in, out
character(*), parameter :: keep="abcd"
in = "a1b*2sdc]a"
call strip(in, out, keep)
print*, TRIM(out)
end program
There are doubtless better and clearer ways to do this: this answer mostly serves to have you think about what intrinsic functions there are and how they can be applied. There isn't an intrinsic function to do what you want in one step.
You need to define an external verification procedure that tells if a given character is to be kept or discarded. Then replace the equivalence check typically done in replace routines with this external function.
Here is an implementation that achieves the goal,
module str_mod
implicit none
integer, parameter :: IK = kind(0)
integer, parameter :: SK = kind("a")
integer, parameter :: LK = kind(.false.)
contains
! Returns `.true.` if it is a desired character.
function isDesired(char) result(desired)
character(1, SK), intent(in) :: char
logical(LK) :: desired
desired = (SK_"0" <= char .and. char <= SK_"9") .or. &
(SK_"A" <= char .and. char <= SK_"Z") .or. &
(SK_"a" <= char .and. char <= SK_"z")
end function
function replace(str, isDesired) result(strrep)
character(*, SK), intent(in) :: str
character(:, SK), allocatable :: strrep
procedure(logical(LK)) :: isDesired
integer(IK) :: i, counter
allocate(character(len(str), SK) :: strrep)
counter = 0_IK
do i = 1, len(str, kind = IK)
if (.not. isDesired(str(i:i))) cycle
counter = counter + 1_IK
strrep(counter:counter) = str(i:i)
end do
strrep = strrep(1:counter)
end function
end module str_mod
use str_mod
print *, replace("Fortran", isDesired)
print *, replace("(Fortran)", isDesired)
print *, replace("(Fortran) (Is) [_A_] (GREAT) {language}.", isDesired)
print *, replace("[AS:1]", isDesired)
end
Here is the program output,
Fortran
Fortran
FortranIsAGREATlanguage
AS1
Test it here. Note that this implementation performs two allocations of the output strings, which you could likely avoid by counting the desired characters in str first and then allocating the output string to the proper size and filling it with the identified characters. But any performance gain or difference will likely be negligible in most scenarios. You would likely see better performance benefits if you instead reimplement replace() in the above as a subroutine with str input argument being an allocatable with intent(inout). In such a case, you can avoid an extra copy on exit from the procedure, which can lead to ~25% runtime speedup for small arrays. But again, such performance concerns become relevant only when you call replace() on the order of billions of times.
You would have to write a function to do it. As inspiration, here's a subroutine I recently wrote to do SQL "escaping" of quotes in a string. The key here is having separate indexes for input and output position. Your requirement is even easier - if the character is not alphanumeric or space, don't advance the output length. There are several ways of doing the comparison, an exercise left for the reader.
subroutine escape (text)
character(*), intent(inout) :: text
character(100) :: newtext
integer i,j
newtext = ' '
j = 1
do i=1,len_trim(text)
if (text(i:i) == '"') then
newtext(j:j) = "\"
j = j + 1
end if
newtext(j:j) = text(i:i)
j = j + 1
end do
text = newtext
end subroutine escape

reading different files from the subroutine depending on the input

I have a piece of code in fortran. I have the files dumped in subroutine. Now I want to call the specific file from the subroutine which depends on m. for eg if m=3 it should read filename(3) and if m=6 it should read filename(6). It is simply not working. Can somebody help me to fix this?
Program main
implicit none
integer,parameter :: dp=kind(1.d0)
real,parameter::m=3
real(dp), dimension(:,:), allocatable :: s
call My_Reader(m)
allocate (s(m,m))
read(m*10,*) s
print*,s
SUBROUTINE My_Reader(m)
integer,parameter :: dp=kind(1.d0)
character (len=256)::filename(m)
integer , intent(in) :: m
filename(6)='C:\Users\spaudel\Documents\S6.txt'
filename(3)='C:\Users\spaudel\Documents\S3.txt'
OPEN (unit=m*10,FILE=fileName(m),status='old', action='read')
END SUBROUTINE My_Reader
in the above program it should print s( my filename is m*m matrix) but sometimes it prints sometimes not. I am using gfortran.
The length of the filename array is given as (m), which is the dummy argument for which of the files you want to read.
So if, for example, you call My_Reader(3), it will only initialize a 3-element array for filename and then anything can happen when you write something to the 6th element.
You could simply fix the size of the filename array in the subroutine declaration block:
character(len=256) :: filename(6)
but I would do something completely different, I'd use a select case to assign the filename in the subroutine:
subroutine my_reader(m)
integer, intent(in) :: m
character(len=256) :: filename
select case (m)
case(3)
filename = 'C:\Users\spaudel\Documents\S3.txt'
case(6)
filename = 'C:\Users\spaudel\Documents\S6.txt'
case default
print *, 'incorrect selection of file number: `, m
STOP
end select
open(unit=m*10, file=filename, ...)
end subroutine my_reader

passing allocatable character through two levels of procedure calls fails

I am experiencing an allocation failure when using allocatable character strings as optional arguments. The problem only occurs when I call through two levels of procedures. In my actual code call get_level1() (see below) represents a call to a list data structure and call get_level2() represents the list calling the same type of accessor function on one of its records. I have stripped down an example to the bare minimum that adequately reproduces the problem.
In the code below when I call get_level2 directly the expected character string is returned through the optional argument. When I call get_level1 which in turn calls get_level2 allocation of the optional dummy argument fails. Using gdb I find the allocation attempt to create a character*1635... when it gets back to the actual argument is obviously has an integer overflow because it thinks the allocation is character*-283635612...
My actual code has many optional arguments not just one. As a simple example I added an optional integer argument. This time instead of a segmentation fault I get a null string.
In the second example the integer argument works regardless of using the character argument. (I would expect this since no dynamic allocation is being performed) The integer's presence has no effect on the character. I have also tried changing the intent to (inout). This does not change the behavior, though I did not expect it to. [I believe that intent(out) causes the actual argument to deallocate first, and intent(inout) retains the actual argument's allocation state]
call get_level1( NUM=n ) ! works
call get_level1( NUM=n, TEXT=words ) ! fails
call get_level1( TEXT=words ) ! fails
my compile cmd is:
gfortran -Wall -g -std=f2008ts stest1.f08 -o stest
Environment
Linux 4.15.0-42-generic #45-Ubuntu SMP x86_64 GNU/Linux
GNU Fortran (Ubuntu 7.3.0-27ubuntu1~18.04) 7.3.0
Example with one optional argument
module stest1
implicit none
character(:), allocatable :: data
contains
subroutine get_level2( TEXT )
implicit none
character(:), optional, allocatable, intent(out) :: TEXT
if ( PRESENT( TEXT ) ) then
TEXT = 'Prefix: ' // data // ' :postfix'
end if
end subroutine get_level2
subroutine get_level1( TEXT )
implicit none
character(:), optional, allocatable, intent(out) :: TEXT
call get_level2( TEXT )
end subroutine get_level1
end module stest1
program main
use stest1
implicit none
character(:), allocatable :: words
data = 'Hello Doctor'
call get_level1( words )
write(*,100) words
100 format( 'words = [',A,']' )
end program main
Example with two optional arguments
module stest2
implicit none
character(:), allocatable :: data
integer :: count
contains
subroutine get_level2( TEXT, NUM )
implicit none
character(:), optional, allocatable, intent(out) :: TEXT
integer, optional, intent(out) :: NUM
if ( PRESENT( TEXT ) ) then
TEXT = 'Prefix: ' // data // ' :postfix'
end if
if ( PRESENT( NUM ) ) then
NUM = count
end if
end subroutine get_level2
subroutine get_level1( TEXT, NUM )
implicit none
character(:), optional, allocatable, intent(out) :: TEXT
integer, optional, intent(out) :: NUM
call get_level2( NUM=NUM, TEXT=TEXT )
end subroutine get_level1
end module stest2
program main
use stest2
implicit none
character(:), allocatable :: words
integer :: n
count = 42
data = 'Hello Doctor'
call get_level1( TEXT=words )
write(*,100) words
write(*,110) n
100 format( 'words = [',A,']' )
110 format( 'N = [',I0,']' )
end program main
You seem to have hit a compiler bug. I can reproduce the issue on gfortran 8.2.1:
Operating system error: Cannot allocate memory
Memory allocation failure in xrealloc
Error termination. Backtrace:
#0 0x7f9c0314f107 in write_character
at ../../../libgfortran/io/write.c:1399
#1 0x7f9c03153e66 in list_formatted_write_scalar
at ../../../libgfortran/io/write.c:1872
#2 0x400c78 in MAIN__
at /tmp/test.F90:43
#3 0x400cbe in main
at /tmp/test.F90:34
but in 5.1.1 I see the correct output:
Prefix: Hello Doctor :postfix
With the following work-around, I got it to work:
subroutine get_level1( TEXT )
implicit none
character(:), optional, allocatable, intent(out) :: TEXT
character(:), allocatable :: tmp
if ( PRESENT( TEXT ) ) then
call get_level2( tmp )
TEXT = tmp
else
call get_level2( )
endif
end subroutine get_level1
It is a bug in the compiler, and still stands in gfortran v9.0.0 (experimental) on Windows. You should report it with the vendor.
I've done some tests and it seems that the failure only happens when: passing a present optional argument as an actual argument corresponding to a dummy argument that is character(:), allocatable, optional. Any variation in the previous sentence seems to avoid the bug and produce the correct result.
I reduced your example to a minimal test-case:
program main
implicit none
character(:), allocatable :: txt
call sub1(txt)
print *, "main ", len(txt), txt ! prints: main 0 (or throws segfault)
contains
subroutine sub1(txt)
character(:), allocatable, optional :: txt
call sub2(txt)
print *, "sub1 ", len(txt), txt ! prints: sub1 0 (or throws segfault)
end
subroutine sub2(txt)
character(:), allocatable, optional :: txt
if(present(txt)) txt = "message"
print *, "sub2 ", len(txt), txt ! prints: sub2 7 message
end
end
The inspection inside sub2 shows that the assignment actually works there. The problem seems to happen when associating that dummy to the actual argument inside sub1. Hmm...
Again, any variation of the pattern character(:), allocatable, optional dummies produces the correct result in my tests. So, I suggest you to flexibilize at least one of the previous conditions to circumvent the buggy thing. There are some suggestions:
1. non-allocatable optional character works, no matter if fixed or assumed length;
Here is an example with fixed-lenght variable and assumed-length arguments.
Advantage: Easy to refactor, less disruptive/intrusive.
Disadvantage: Must estimate the length of the variable beforehand, wastes storage.
program option1
implicit none
character(10) :: txt
call sub1(txt)
print *, "main ", len(txt), txt ! prints: main 10 message
contains
subroutine sub1(txt)
character(*), optional :: txt
call sub2(txt)
print *, "sub1 ", len(txt), txt ! prints: sub1 10 message
end
subroutine sub2(txt)
character(*), optional :: txt
if(present(txt)) txt = "message"
print *, "sub2 ", len(txt), txt ! prints: sub1 10 message
end
end
2. non-optional, on either the actual argument passed from sub1 or on the dummy argument in sub2, also makes it work;
Of course, if you can refactor your code to avoid this situation, that would be the better solution. You could use generic interfaces to achieve a similar result, for example. Or, as you said in the comment, "using local variables at level1 and passing all the optional arguments to the lower level".
Disadvantage: May need to change interfaces of the lower-level procedures.
Advantage: Wouldn't be a problem if they are private module procedures; It's an implementation detail.
Consider the following approach, that hacks the bug and avoid passing an optional argument, so doesn't change the procedure's signature:
program option2
implicit none
character(:), allocatable :: txt
call sub1(txt)
print *, "main ", len(txt), txt ! prints: main 7 message
contains
subroutine sub1(txt)
character(:), allocatable, optional :: txt
character(:), allocatable :: txt_
if(present(txt)) then
! txt_ isn't optional, so the bug doesn't fire
call sub2(txt_)
txt = txt_
end if
print *, "sub1 ", len(txt), txt ! prints: sub1 7 message
end
subroutine sub2(txt)
character(:), allocatable, optional :: txt
print *, present(txt)
if(present(txt)) txt = "message"
print *, "sub2 ", len(txt), txt ! prints: sub2 7 message
end
end
3. with any other type it works too, no matter the attributes (even a derived-type with allocatable character component). Although, changes on the rank or kind don't count.
I will show you two options involving derived types: one with allocatable character length component; the other with parameterized derived type.
Advantage: You can keep your code structure, and all the optional stuff. Storage overhead is low. You could even extend your DT with methods and tailor it to your problem.
Disadvantage: Maybe too much hassle for little. PDT is cool, but is a new (and buggy) feature in gfortran.
program option3a
! using a derived type with allocatable character length component.
implicit none
type :: string
character(:), allocatable :: chars
end type
type(string) :: txt
call sub1(txt)
print *, "main ", len(txt%chars), txt%chars ! prints: main 7 message
contains
subroutine sub1(txt)
type(string), optional :: txt
call sub2(txt)
print *, "sub1 ", len(txt%chars), txt%chars ! prints: sub1 7 message
end
subroutine sub2(txt)
type(string), optional :: txt
if(present(txt)) txt = string("message")
print *, "sub2 ", len(txt%chars), txt%chars ! prints: sub2 7 message
end
end
program option3b
! using a parameterized derived type, you can practically mimic the intrinsic
! character type behavior, with the possibility to add custom behavior.
! but its still raw in gfortran.
implicit none
type :: string(len)
integer, len :: len
character(len) :: chars
end type
type(string(:)), allocatable :: txt
call sub1(txt)
print *, "main ", txt%len, txt ! prints: main 7 7 message (a lil bug of gfortran)
contains
subroutine sub1(txt)
type(string(:)), allocatable, optional :: txt
call sub2(txt)
print *, "sub1 ", txt%len, txt ! prints: main 7 7 message
end
subroutine sub2(txt)
type(string(:)), allocatable, optional :: txt
! the following fails with gfortran, however it's valid syntax
! if(present(txt)) txt = string(7)("message")
allocate(string(7) :: txt)
if(present(txt)) txt%chars = "message"
print *, "sub2 ", txt%len, txt ! prints: main 7 7 message
end
end
Summing up: you can change your compiler or choose any of those (or other) way to circunvent this bug and keep working, until your compiler vendor address the issue.

I've Encountered a Segmentation Error Fortran on Reading Data Files from an Outside source

I've been writing a program that reads an integer value from a file using the OPEN statement and prints the value on the console.
During the compiling, it seems to be okay and got no problems, but when I run the program, I've encountered a segmentation fault.
I've reviewed the code and so far I haven't violated any rules. Can someone to give me an idea about this problem?
Error:
Code:
program project5_03
implicit none
integer :: n = 0
open ( unit = 21, file = 'trial.txt', status = 'old')
read (21,*) n
print '(1x,a,i4)', "this is the value of n", n
stop
end program
The content of the txt file is just the number "1234" on the first line.
Hmmm, the code should work. It would have been nice if you had actually given us the compiler version and -options as well.
I mean there is the thing that you're not closing the file that you've opened, but since the program terminates anyway, it shouldn't be much of an issue.
What I'd do is use the error status and -message variables, something like this:
program project5_03
implicit none
integer :: n
integer :: ios
character(len=200) :: iomsg
open (unit=21, file='trial.txt', status='old', iostat=ios, iomsg=iomsg)
call check(ios, iomsg, "OPEN")
read (21,*, iostat=ios, iomsg=iomsg) n
call check(ios, iomsg, "READ n")
write(*,'(1x,a,i4)', iostat=ios, iomsg=iomsg), "this is the value of n", n
call check(ios, iomsg, "WRITE to STDOUT")
stop
contains
subroutine check(ios, iomsg, op)
implicit none
integer, intent(in) :: ios
character(len=*), intent(in) :: iomsg, op
if (ios == 0) return
print*, "Encountered Error ", ios, " during ", op
print*, iomsg
stop
end subroutine check
end program
Maybe this will help you find the bug.
There is also the fact that you use integer :: n = 0 -- which should not be a problem with the main program, but in subroutines this implies the SAVE attribute.

How to write string array to a HDF5 dataset with Fortran API?

A string array is defined using fortran language:
character(len = 20), dimension(5) :: strings = (/"hello", "world", "Hello", "HDF5", "fortran"/)
Now I want to save this array into a dataset using h5ltmake_dataset_string_f() interface illustrated by HDF5 API reference documentation
Fortran90 Interface: h5ltmake_dataset_string_f
subroutine h5ltmake_dataset_string_f(loc_id,dset_name,buf,errcode )
implicit none
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
character(LEN=*), intent(IN), dimension(:) :: buf ! data buffer
integer :: errcode ! error code
end subroutine h5ltmake_dataset_string_f
My calling code below
h5ltmake_dataset_string_f(group_id, dset_name, strings, error)
and group_id, dset_name and error have been defined before subroutine call.
But when I compile and build this code, compile error occurs says
h5ltmake_dataset_string_f(): the actual arguments and dummy arguments have been violated!
So how to write the strings into one dataset?
Use API h5dwrite_f(...), not h5ltmake_dataset_f() to write string array.
Although the issue was opened several years ago, here goes a solution to write an array of strings ("hello", "world", "Hello", "HDF5", "fortran") into an HDF5 dataset in Fortran using HDFql (http://www.hdfql.com). Posting this in case others find themselves struggling with HDF5 low-level details when performing this type of operation:
PROGRAM Example
! use HDFql module (make sure it can be found by the Fortran compiler)
USE HDFql
! declare variables
CHARACTER(LEN = 20), DIMENSION(5) :: strings = [CHARACTER(LEN = 20) :: "hello", "world", "Hello", "HDF5", "fortran"]
CHARACTER :: variable_number
INTEGER :: state
! create an HDF file named "example.h5" and use (i.e. open) it
state = hdfql_execute("CREATE AND USE FILE example.h5")
! create a dataset named "my_dataset" of type char (size 20) of one dimension (size 5)
state = hdfql_execute("CREATE DATASET my_dataset AS CHAR(5, 20)");
! register variable "strings" for subsequent use (by HDFql)
state = hdfql_variable_transient_register(strings)
WRITE(variable_number, "(I0)") state
! insert (i.e. write) content of variable "strings" into dataset "my_dataset"
state = hdfql_execute("INSERT INTO my_dataset VALUES FROM MEMORY " // variable_number)
END PROGRAM