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
Related
Let's say I want to perform an operation in my main program (in Fortran). And lets say that operation is finding minimum number in a 1D array. I wish to do so by passing the array into the call subroutine and the subroutine will print the minimum value on the screen. There are different ways or algorithms to find minimum value in an array. Lets say I have 100 different methods: Method1, Method2..... Method100. Now I want to try using each one of these methods separately (I don't want to try all of them at once, but one method in each run). I don't want to create 100 different subroutines and change the code every time to decide which one to call, rather I want to mention in the input file which one I want to choose. So basically, the computer has to read the input file (to know which method to use) and perform the task using the specified method amongst different methods available.
I can write a Subroutine dump all the methods into that subroutine and put an IF condition to choose among various methods. But IF conditions are in efficient particularly on GPUs, I want to know the most efficient way of doing this.
MAIN PROGRAM
INTEGER Method !will be read from input file
Array = [12,5,3,4,1,7,4,3]
call print_Minimum(Array)
END PROGRAM
SUBROUTINE print_Minimum(Array)
IF (METHOD == 1)
<method 1 code>
ELSE IF (METHOD == 2)
<method 2 code>
:
:
:
:
ELSE IF (METHOD == 100)
<method100 code>
END IF
END SUBROUTINE
Thanks in advance.
This is probably best done using a function pointer and/or functions as arguments.
You can set a function pointer to a certain function and do this in your nested ifs and you can pass functions as arguments.
Both methods are implemented in the following example.
module minimum_mod
implicit none
private
public :: get_min_t, naive_min, time_min_function
abstract interface
integer pure function get_min_t(X)
integer, intent(in) :: X(:)
end function
end interface
contains
subroutine time_min_function(f, X)
procedure(get_min_t) :: f
integer, intent(in) :: X(:)
integer :: res
res = f(X)
write(*, *) res
end subroutine
integer pure function naive_min(X)
integer, intent(in) :: X(:)
integer :: i
naive_min = huge(naive_min)
do i = 1, size(X)
naive_min = min(naive_min, X(i))
end do
end function
end module
program time_min_finders
use minimum_mod, only: get_min_t, naive_min, time_min_function
implicit none
integer, parameter :: test_set(5) = [1, 10, 3, 5, 7]
procedure(get_min_t), pointer :: f
f => naive_min
call time_min_function(f, test_set)
end program
PS: Note that you can now do all the timinig logic inside time_min_function.
You can create an array of a derived type that contains a function pointer, effectively an array of function pointers. Then in principle you could initialize the function pointers to point at all of your test functions so that you could refer to each function by its index without having to test with a SELECT CASE of IF block: this is the typical Fortran way. However, either I've got the syntax for initialization wrong or my old version of gfortran just isn't capable, so I had to initialize one at a time. Sigh.
module minfuncs
implicit none
abstract interface
function func(array)
integer, intent(in) :: array(:)
integer func
end function func
end interface
type func_node
procedure(func), NOPASS, pointer :: f
end type func_node
! type(func_node) :: method(5) = [func_node(min_1),func_node(min_2), &
! func_node(min_3),func_node(min_4),func_node(min_5)]
contains
function min_1(array)
integer, intent(in) :: array(:)
integer min_1
integer i
min_1 = array(1)
do i = 2, size(array)
min_1 = min(min_1,array(i))
end do
end function min_1
function min_2(array)
integer, intent(in) :: array(:)
integer min_2
integer i
min_2 = array(1)
do i = 8, size(array), 7
min_2 = min(min_2,array(i-6),array(i-5),array(i-4), &
array(i-3),array(i-2),array(i-1),array(i))
end do
do i = i-6, size(array)
min_2 = min(min_2, array(i))
end do
end function min_2
function min_3(array)
integer, intent(in) :: array(:)
integer min_3
integer i
min_3 = array(1)
do i = 2, size(array)
min_3 = min_3-dim(min_3,array(i))
end do
end function min_3
function min_4(array)
integer, intent(in) :: array(:)
integer min_4
integer ymm(8)
integer i
if(size(array) >= 8) then
ymm = array(1:8)
do i = 16, size(array), 8
ymm = min(ymm,array(i-7:i))
end do
min_4 = minval([ymm,array(i-7:size(array))])
else
min_4 = minval(array)
end if
end function min_4
function min_5(array)
integer, intent(in) :: array(:)
integer min_5
min_5 = minval(array)
end function min_5
end module minfuncs
program test
use minfuncs
implicit none
integer, parameter :: N = 75
integer i
integer :: A(N) = modulo(5*[(i,i=1,N)]**2,163)
! type(func_node) :: method(5) = [func_node(min_1),func_node(min_2), &
! func_node(min_3),func_node(min_4),func_node(min_5)]
type(func_node) method(5)
method(1)%f => min_1
method(2)%f => min_2
method(3)%f => min_3
method(4)%f => min_4
method(5)%f => min_5
do i = 1, size(method)
write(*,*) method(i)%f(A)
end do
end program test
Output:
2
2
2
2
2
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
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 have a large text file like this:
!species #Oxygen
ind_CO 1.0
ind_CO2 2.0
ind_CH4 0.0
ind_O3 3.0
but in my code the characters (ind_CO, ind_CO2, etc) are declared like this:
INTEGER, PARAMETER :: ind_CO2 = 1
INTEGER, PARAMETER :: ind_CH4 = 2
INTEGER, PARAMETER :: ind_O3 = 3
INTEGER, PARAMETER :: ind_CO = 4
And the concentration of each species is calculated as C(ind_). So I want
to calculate the product of C(ind_)*(#Oxygen) for each one. That is, I would like to relate the data of text file and those of code. I tried something like this:
program
implicit none
INTEGER, PARAMETER :: ind_CO2 = 1
INTEGER, PARAMETER :: ind_CH4 = 2
INTEGER, PARAMETER :: ind_O3 = 3
INTEGER, PARAMETER :: ind_CO = 4
REAL :: C(4) ! Concentration for each Compound
REAL :: numO ! Number of Oxygens
REAL :: ANS(4) ! To Calculate
INTEGER :: err
CHARACTER :: species*11
open (unit=15, file="data.txt", status='old',access='sequential', form='formatted', action='read' )
err=0
do
read (15, *,IOSTAT=err) species, numO
if (err==-1) exit
! I don 't know if it is possible to convert a character to an integer
! parameter in such a way that the index of the matrix corresponds to
! the right compound
ANS(species) = C(species)*numO
write (*, *) species, numO, ANS(species)
enddo
close(15)
end program
I know it is not correct, but my idea is to insert at the matrix C the name that is saved for each compound at the beginning of the code.
So I would like to ask you if it is possible to read or convert these characters and relate them to the declared parameters.
In fortran there is no intrinsic way to map symbol names to character strings. The simplest approach here is to simply store your species names as a character array and use a loop to find the matching name for the string you read from the file.
implicit none
integer :: i
integer, parameter :: nspecies=4
character(len=11),dimension(nspecies) :: species= &
['ind_CO2','ind_CH4','ind_O3','ind_CO']
character(len=11) :: input
input='ind_CH4' ! from file
do i = 1,nspecies
if ( input .eq. species(i) )exit
enddo
if ( i.gt.nspecies )then
write(*,*)'error ',input,' not found'
else
write(*,*)'read input is ',i,trim(species(i))
endif
end
I have the following function:
function fname(proc, ct) result(filename)
implicit none
integer, intent(in) :: proc, ct
character(len=100) :: filename
write(filename,"(a,i9.9,a,i0,a)") "/step", ct, "-proc", proc, ".txt"
end function fname
In modern Fortran, is there an automatic way to have the resulting string to have the minimum possible size to fit all the formatted data? Notice the use of i0 format makes the size of the resulting string variable.
It is possible, but not directly in the read statement. If you wrap the integer to string conversion into a function:
function itoa(i) result(res)
character(:),allocatable :: res
integer,intent(in) :: i
character(range(i)+2) :: tmp
write(tmp,'(i0)') i
res = trim(tmp)
end function
you can then use allocatable deferred-length string
character(:), allocatable :: filename
filename = "/step" // itoa99(ct) // "-proc" // itoa(proc) // ".txt"
You can adjust the function, to take the integer format as a dummy argument instead of making more versions of it.
The other possibility is to have a large temporary string and trim it
character(100) :: tmp
character(:), allocatable :: filename
write(tmp,"(a,i9.9,a,i0,a)") "/step", ct, "-proc", proc, ".txt"
filename = trim(tmp)