reading different files from the subroutine depending on the input - fortran

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

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

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.

Reading characters array from a text file and convert it to an integer parameter

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

How to format to a string with minimum possible size

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)

Fortran90 wrong output

i'm working on a small program for a course in university and i'm almost finished but somehow it doesn't work as i want it to work.
Now, the output file gravity1.dat should give me values unequal to 0. But it doesnt... Somewhere in the last formula where i calculate g(surf), one of the variables is 0. If tried almost everything in my power to correct it but i can't seem to fix it.
program gravity
implicit none
real(8) Lx,Ly,sx,sy,xsphere,ysphere,r,A,rho1,rho2,dx,G
integer np,nel,nelx,nely,i,nnx,nny,j,counter,nsurf
real(8),dimension(:),allocatable :: xcgrid
real(8),dimension(:),allocatable :: ycgrid
real(8),dimension(:),allocatable :: xgrid
real(8),dimension(:),allocatable :: ygrid
real(8),dimension(:),allocatable :: rho
real(8),dimension(:),allocatable :: xsurf, gsurf
real(8),dimension(:),allocatable :: ysurf
nnx=11.
nny=11.
Lx=10.
Ly=10.
nelx=nnx-1.
nely=nny-1.
nel=nelx*nely
np=nnx*nny
sx=Lx/nelx
sy=Ly/nely
xsphere=5.
ysphere=5.
r=3.
nsurf=7 !number of gravimeters
dx=Lx/(nsurf-1.)
!==========================================================
allocate(xgrid(np))
allocate(ygrid(np))
counter=0
do i=1,nnx
do j=1,nny
counter=counter+1
xgrid(counter)=dble(i-1)*sx
ygrid(counter)=dble(j-1)*sy
end do
end do
call write_two_columns(np,xgrid,ygrid,'grid_init1.dat')
!==========================================================
allocate(xcgrid(np))
allocate(ycgrid(np))
counter=0
do i=1,nnx-1
do j=1,nny-1
counter=counter+1
xcgrid(counter)=dble(i-1)*sx+0.5*sx
ycgrid(counter)=dble(j-1)*sy+0.5*sy
end do
end do
call write_two_columns(np,xcgrid,ycgrid,'gridc_init1.dat')
!==========================================================
allocate(rho(nel))
rho1=3000. !kg/m^3
rho2=3200. !kg/m^3
do i=1,nel
if (sqrt((xsphere-xcgrid(i))**2)+((ysphere-ycgrid(i))**2)<r) then
rho(i)=3200.
else
rho(i)=3000.
end if
end do
call write_three_columns(nel,xcgrid,ycgrid,rho,'inclusion1.dat')
!==========================================================
allocate(xsurf(nsurf))
allocate(ysurf(nsurf))
do i=1,nsurf
xsurf(i)=(i-1)*dx
ysurf(i)=ly
end do
call write_two_columns(nsurf,xsurf,ysurf,'surf_init1.dat')
!==========================================================
allocate(gsurf(nsurf))
G=0.000000000066738480 !m^3 kg^-1 s^-2
do i=1,nsurf
do j=1,nel
gsurf(i)=gsurf(i)+(-2.*G*(((rho(i)-rho1)*(ycgrid(counter)-ysurf(i)))/((xcgrid(counter)-xsurf(i))**2.+(ycgrid(counter)-ysurf(i))**2.))*sx*sy)
end do
end do
call write_two_columns(nsurf,xsurf,gsurf,'gravity1.dat')
deallocate(xgrid)
deallocate(ygrid)
deallocate(xcgrid)
deallocate(ycgrid)
deallocate(xsurf)
deallocate(ysurf)
deallocate(gsurf)
end program
The subroutines used:
!===========================================
subroutine write_two_columns (nnn,xxx,yyy,filename)
implicit none
integer i,nnn
real(8) xxx(nnn),yyy(nnn)
character(LEN=*) filename
open(unit=123,file=filename,action='write')
do i=1,nnn
write(123,*) xxx(i),yyy(i)
end do
close(123)
end subroutine
and the other subroutine:
!===========================================
subroutine write_three_columns (nnn,xxx,yyy,zzz,filename)
implicit none
integer i,nnn
real(8) xxx(nnn),yyy(nnn),zzz(nnn)
character(LEN=*) filename
open(unit=123,file=filename,action='write')
do i=1,nnn
write(123,*) xxx(i),yyy(i),zzz(i)
end do
close(123)
end subroutine
!===========================================
Shouldn't it be (rho(j)-rho1)? You fill rho(1:nel), but only use rho(1:7)!
By the way, be careful with your variable initialization... You assign reals to integers, and do mixed type arithmetics. Be careful with this as it might lead to unexpected results. Use your compiler to detect those issues.