How do you use your variables in a different file in Fortran? - function

I have a problem with a Fortran project and figured out maybe you could help me.
I'm using codeblocks as IDE and there you can make projects, so I created a project with two files in it: a main program and a fuction (I don't know what else to use, I could use something different from a fuction maybe).
So I have my function that reads values from a .txt and saves them as real numbers and everything is working good. What I want to do is, from the file main, call this function and save in main the data I collected with my function so that the main remains cleaner.
How would I do that? I can post the whole script if you want, but I don't think it would add that much more.
EDIT: As you asked, here it is (uncut):
program main
! Variables
real :: d1, r1, r2, a, teta, freq, Dt, mu, g0, r_t, height, r, omega, H, lx, ly, lz, m_c0, &
Jx, Jy, Jz, gmax, I_s, K, Jx0, Jy0, Jz0, Vmin, tsp_0, Fmax, Isp, c1, n, F, DV, tfin, cont, Tmax
real :: data_input
! Call the funcion
data_input=data_module(d1, r1, r2, a, teta, freq, Dt, mu, g0, r_t, height, r, omega, H, lx, ly, lz, m_c0, &
Jx, Jy, Jz, gmax, I_s, K, Jx0, Jy0, Jz0, Vmin, tsp_0, Fmax, Isp, c1, n, F, DV, tfin, cont, Tmax)
! Error
if (data_input/=1) then
print*, 'ERROR: data_module did not work'
end if
!Just to show it
print*,'After'
print*, d1, r1, r2, a, teta, freq, Dt, mu, g0, r_t, height, r, omega, H, lx, ly, lz, m_c0, &
Jx, Jy, Jz, gmax, I_s, K, Jx0, Jy0, Jz0, Vmin, tsp_0, Fmax, Isp, c1, n, F, DV, tfin, cont, Tmax
end program main
real function data_module ()
! Variables
implicit none
integer :: flag_read=0, w_int, d_int
real:: coefficient, d1, r1, r2, a, teta, freq, Dt, mu, g0, r_t, height, r, omega, H, lx, ly, lz, m_c0, &
Jx, Jy, Jz, gmax, I_s, K, Jx0, Jy0, Jz0, Vmin, tsp_0, Fmax, Isp, c1, n, F, DV, tfin, cont, Tmax
character (LEN=35) :: starting_string, name*15, coefficient_string*20, w_string, d_string, number_format
character :: w*2, d
! Open file
open (11, file = 'Data.txt', status = 'old', access = 'sequential', form = 'formatted')
! Read a new line for every iteration
sentence_reader: do while (flag_read==0)
read (11, fmt='(A)', iostat = flag_read) starting_string
! Error
if (flag_read>0)then
print*, 'ERROR: could not read data'
stop
end if
! Skip useless lines
if (starting_string(1:1)=='%' .OR. starting_string(1:1)==' ') then
cycle
end if
! Exit when you're done
if (flag_read<0)then
exit sentence_reader
end if
! Just stuff to prepare it
name=trim(starting_string(1:index(starting_string, '=')-1))
coefficient_string=trim(adjustl(starting_string(index(starting_string, '=')+1:index(starting_string,';')-1)))
if (scan(coefficient_string,'E')/=0) then
w_string=coefficient_string
w_int=len_trim(w_string)
write(w, '(BN,I2)') w_int
d_string=coefficient_string(index(coefficient_string, '.')+1:index(coefficient_string, 'E')-1)
d_int=len_trim(d_string)
write(d, '(BN,I1)') d_int
!All togheter
number_format='(BN,F' // trim(w) // '.' // d // ')'
else
w_string=coefficient_string
w_int=len_trim(w_string)
write(w, '(BN,I1)') w_int
d_string=coefficient_string(index(coefficient_string, '.')+1:len_trim(coefficient_string))
d_int=len_trim(d_string)
write(d, '(BN,I1)') d_int
number_format='(BN,F' // trim(w) // '.' // d // ')'
end if
! Read the number
read(coefficient_string,number_format) coefficient
! Save where it's needed (is there an easier way to do it?)
select case (name)
case ('d1')
d1=coefficient
case ('r1')
r1=coefficient
case ('r2')
r2=coefficient
case ('a')
exit
case ('teta')
exit
case ('freq')
freq=coefficient
case ('Dt')
exit
case ('mu')
mu=coefficient
case ('g0')
g0=coefficient
case ('r_t')
r_t=coefficient
case ('height')
height=coefficient
case ('lx')
lx=coefficient
case ('ly')
ly=coefficient
case ('lz')
lz=coefficient
case ('m_c0')
m_c0=coefficient
case ('Jx')
Jx=coefficient
case ('Jy')
Jy=coefficient
case ('Jz')
Jz=coefficient
case ('gmax')
gmax=coefficient
case ('I_s')
I_s=coefficient
case ('K')
K=coefficient
case ('Vmin')
Vmin=coefficient
case ('tsp_0')
tsp_0=coefficient
case ('Fmax')
Fmax=coefficient
case ('Isp')
Isp=coefficient
case ('n')
n=coefficient
case ('tfin')
tfin=coefficient
case ('cont')
cont=coefficient
case ('Tmax')
Tmax=coefficient
case default
print*, 'Variable ', name, ' is not recognized'
end select
end do sentence_reader
! Other stuff I need
teta=atan((r1 - r2)/d1)
a=sqrt(d1**2 + (r1 - r2)**2)
Dt=1/freq
r=r_t + height
omega=(mu/(r**3))**0.5
H=(r*mu)**0.5
Jx0=Jx - I_s
Jy0=Jy - I_s
Jz0=Jz - I_s
c1=Isp*g0
F=n*Fmax
DV=(F/m_c0)*tsp_0
! Shows that the function is correctly executed
data_module=1
print*,'Before'
print*, d1, r1, r2, a, teta, freq, Dt, mu, g0, r_t, height, r, omega, H, lx, ly, lz, m_c0, &
Jx, Jy, Jz, gmax, I_s, K, Jx0, Jy0, Jz0, Vmin, tsp_0, Fmax, Isp, c1, n, F, DV, tfin, cont, Tmax
end function data_module
PS. I know modules, but with open and all the other stuff I couldn't get them to work. Would love to.
What I want to do is to pass the data d1, r1, ecc that I collected in data_module to main and save them in main, but doing it this way it doesn't save them (if you run it, when you print them "before" everything is fine, when you print them "after" you got all zeros.

Okay, there are a few things I notice.
Your function is of type real, but you set it only to 1 (an integer), to, as you put it in the comment "Show that the function is correctly executed".
It's not uncommon to make a procedure return a value to show whether it executed correctly or not, but it's usually an error code, with zero meaning that no error occurred and everything went fine.
Also, you might want to declare the function as integer instead of real, as integers are better for that kind of thing. (More reliable to compare.)
As to your actual question: If you want to pass more than a single value back to the calling routine, you would want to declare intent(out) dummy variables. See this example:
integer function test_output(outdata)
integer, intent(out) :: outdata(10)
integer :: i
outdata = (/(i, i=1, 10)/)
! All worked well
test_output = 0
return
end function test_output
Modules are the way to go. Here is a very limited example on how to incorporate the function above into a module, and using that module in a program:
module mod_test
implicit none
! Here you can place variables that should be available
! to any procedure using this module
contains
! Here you can place all the procedures (functions and
! subroutines)
integer function test_output(outdata)
integer, intent(out) :: outdata(10)
integer :: i
outdata = (/(i, i=1, 10)/)
! All worked well
test_output = 0
return
end function test_output
end module mod_test
program test
! The 'USE' statement is the only thing that needs to be
! *ahead* of the 'implicit none'
use mod_test
implicit none
integer :: mydata(10) ! The variable that will contain the data
! from the function
integer :: status ! The variable that will contain the error
! code.
status = test_output(mydata)
if (status == 0) then
print*, mydata
end if
end program test
If the module is in a different source file, you need to compile them this way (assuming that you use gfortran):
$ gfortran -c -o mod_test.o mod_test.f90
$ gfortran -c -o test.o test.f90
$ gfortran -o test test.o mod_test.o

Related

Using matrices as arguments in functions and as output in subroutines in Fortran

I was trying to create a program that requires me to use matrices as input for functions and subroutines and also requires me to take matrix as subroutine output in Fortran. But, I've encountered multiple errors while doing so. I am not able to understand the source of these errors and hence how to fix them.
I'm confident of the logic but I seem to be making errors in dealing with the matrices.
Program to solve system of linear equations(Gauss elimination with partial pivoting)
Code:
program solving_equations
implicit none
real, allocatable :: a(:,:),interchanged(:,:)
real, allocatable :: x(:)
real addition,multiplying_term,alpha,maximum
integer i,j,row,rth_ele,f_maxfinder,k,n,s,inte
read(*,*)n
allocate( a( n,(n+1) ) )
allocate( x(n) )
allocate( interchanged( n,(n+1) ) )
do i=1,n
read(*,*)( a(i,j),j=1,(n+1) )
end do
do rth_ele= 1,(n-1)
row=f_maxfinder( a , n , rth_ele )
if (row==rth_ele) then
continue
else
call interchanger(a,rth_ele,row,n,interchanged)
a = interchanged
end if
do i= (rth_ele+1) , n
! once i is fixed, multiplying term is fixed too
multiplying_term=( a(i,rth_ele)/a(rth_ele,rth_ele) )
do j=1,(n+1)
a(i,j)=a(i,j)-a(rth_ele,j)*multiplying_term
end do
end do
end do
x(n)=a(n,n+1)/a(n,n)
do i=(n-1),1,-1
addition=0.0
do s=n , (i+1) , -1
addition=addition+a(i,s)*x(s)
end do
x(i)= ( ( a(i,n+1)- addition )/a(i,i) )
end do
do i=1,n
print*,x(i)
end do
endprogram solving_equations
!=================
function f_maxfinder(a,n,rth_ele)
integer inte,f_maxfinder
real maximum
maximum=a(rth_ele,rth_ele)
do inte=n,nint(rth_ele+1),-1
if( a(inte,rth_ele) > maximum ) then
maximum = a(inte,rth_ele)
f_maxfinder=inte
else
continue
end if
end do
end
subroutine interchanger( a,rth_ele,row,n,interchanged )
integer i
real alpha
real, allocatable :: interchanged(:,:)
allocate( interchanged( n,(n+1) ) )
do i=1,n+1
alpha=a(row,i)
a(row,i)=a(rth_ele,i)
a(rth_ele,i)=alpha
end do
do i=1,n
do j=1,(n+1)
interchanged(i,j)=a(i,j)
end do
end do
end
Errors:
row=f_maxfinder( a , n , rth_ele )
1
Warning: Rank mismatch in argument 'a' at (1) (scalar and rank-2)
a(row,i)=a(rth_ele,i)
Error: The function result on the lhs of the assignment at (1) must have the pointer attribute.
a(rth_ele,i)=alpha
Error: The function result on the lhs of the assignment at (1) must have the pointer attribute.
call interchanger(a,rth_ele,row,n,interchanged)
1
Error: Explicit interface required for 'interchanger' at (1): allocatable argument
Thanks!
You're missing a declaration of a as an array in f_maxfinder. implicit none is your friend - be sure to use it all the time.
interchanger has a dummy argument interchanged that is an allocatable, assumed-shape array. This requires that an explicit interface to interchanger be visible in the caller. (See my post https://stevelionel.com/drfortran/2012/01/05/doctor-fortran-gets-explicit-again/ for more on this.
The interface issue could be solved by putting the subroutines in a module and adding a use of the module in the main program.
By the way, there's no need to make a allocatable in f_maxfinder, as you are not allocating or deallocating it. It is still an assumed-shape array so the explicit interface is still required.
Here is a working example taking into account #SteveLionel's advice and the following comments:
Always use implicit none, at least once in the main program and don't forget to pass the -warn flag to the compiler.
Either use a module for functions and subroutines, then add use <module> to the main program, or simply use contains and include them inside the main program as I did below.
The interchanged array is already alcated in the main program, you don't need to re-allocate it in the interchanger subroutine, just pass it as an assumed-shape array.
Remove unused variables; alpha, maximum, k, inte.
Define a in f_maxfinder function.
Function type is better written in front of the function name for readability; see your definition of f_maxfinder and don't declare the function again in main program, unless you're using an explicit interface.
The nint procedure accepts real input, you don't need it here.
Finally add any missing variable declarations in your function/subroutine.
program solving_equations
implicit none
real, allocatable :: a(:,:), interchanged(:,:), x(:)
real :: addition, multiplying_term
integer :: i, j, row, rth_ele, n, s
read (*,*) n
allocate ( a( n,(n+1) ) )
allocate ( x( n ) )
allocate ( interchanged( n,(n+1) ) )
do i = 1,n
do j = 1,(n+1)
read (*,*) a(i,j)
end do
end do
do rth_ele = 1,(n-1)
row = f_maxfinder( a , n , rth_ele )
if (row == rth_ele) then
continue
else
call interchanger(a, rth_ele, row, n, interchanged)
a = interchanged
end if
do i = (rth_ele+1) , n
! once i is fixed, multiplying term is fixed too
multiplying_term = a(i,rth_ele) / a(rth_ele,rth_ele)
do j = 1,(n+1)
a(i,j) = a(i,j) - a(rth_ele,j) * multiplying_term
end do
end do
end do
x(n) = a(n,n+1) / a(n,n)
do i = (n-1),1,-1
addition = 0.0
do s = n,(i+1),-1
addition = addition + a(i,s) * x(s)
end do
x(i)= (a(i,n+1) - addition) / a(i,i)
end do
do i = 1,n
print *, x(i)
end do
contains
integer function f_maxfinder(a, n, rth_ele)
integer :: n, rth_ele, inte
real :: maximum, a(:,:)
maximum = a(rth_ele,rth_ele)
do inte = n,rth_ele+1,-1
if (a(inte,rth_ele) > maximum) then
maximum = a(inte,rth_ele)
f_maxfinder = inte
else
continue
end if
end do
end
subroutine interchanger( a, rth_ele, row, n, interchanged )
integer :: i, rth_ele, row, n
real :: alpha, a(:,:), interchanged(:,:)
do i = 1,n+1
alpha = a(row,i)
a(row,i) = a(rth_ele,i)
a(rth_ele,i) = alpha
end do
do i = 1,n
do j = 1,(n+1)
interchanged(i,j) = a(i,j)
end do
end do
end
end program solving_equations
Entering a sample 3-by-4 array, you get the following output (check the results, you know your algorithm):
3
4
3
6
3
7
4
6
7
4
4
2
0
2.05263186
-2.15789509
0.210526198
Process returned 0 (0x0) execution time : 1.051 s
Press any key to continue.

Adding a print statement in a Fortran 90 function this do not work [duplicate]

I'm trying to learn Fortran (unfortunately a necessity for my research group) - one of the tasks I set myself was to package one of the necessary functions (Associated Legendre polynomials) from the Numerical Recipes book into a fortran 03 compliant module. The original program (f77) has some error handling in the form of the following:
if(m.lt.0.or.m.gt.1.or.abs(x).gt.1)pause 'bad arguments in plgndr'
Pause seems to have been deprecated since f77 as using this line gives me a compiling error, so I tried the following:
module sha_helper
implicit none
public :: plgndr, factorial!, ylm
contains
! numerical recipes Associated Legendre Polynomials rewritten for f03
function plgndr(l,m,x) result(res_plgndr)
integer, intent(in) :: l, m
real, intent(in) :: x
real :: res_plgndr, fact, pll, pmm, pmmp1, somx2
integer :: i,ll
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
res_plgndr=-10e6 !return a ridiculous value
else
pmm = 1.
if (m.gt.0) then
somx2 = sqrt((1.-x)*(1.+x))
fact = 1.
do i = 1, m
pmm = -pmm*fact*somx2
fact = fact+2
end do
end if
if (l.eq.m) then
res_plgndr = pmm
else
pmmp1 = x*(2*m+1)*pmm
if(l.eq.m+1) then
res_plgndr = pmmp1
else
do ll = m+2, l
pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m)
pmm = pmmp1
pmmp1 = pll
end do
res_plgndr = pll
end if
end if
end if
end function plgndr
recursive function factorial(n) result(factorial_result)
integer, intent(in) :: n
integer, parameter :: RegInt_K = selected_int_kind(20) !should be enough for the factorials I am using
integer (kind = RegInt_K) :: factorial_result
if (n <= 0) then
factorial_result = 1
else
factorial_result = n * factorial(n-1)
end if
end function factorial
! function ylm(l,m,theta,phi) result(res_ylm)
! integer, intent(in) :: l, m
! real, intent(in) :: theta, phi
! real :: res_ylm, front_block
! real, parameter :: pi = 3.1415926536
! front_block = sqrt((2*l+1)*factorial(l-abs(m))/(4*pi*))
! end function ylm
end module sha_helper
The main code after the else works, but if I execute my main program and call the function with bad values, the program freezes before executing the print statement. I know that the print statement is the problem, as commenting it out allows the function to execute normally, returning -10e6 as the value. Ideally, I would like the program to crash after giving a user readable error message, as giving bad values to the plgndr function is a fatal error for the program. The function plgndr is being used by the program sha_lmc. Currently all this does is read some arrays and then print a value of plgndr for testing (early days). The function ylm in the module sha_helper is also not finished, hence it is commented out. The code compiles using gfortran sha_helper.f03 sha_lmc.f03 -o sha_lmc, and
gfortran --version
GNU Fortran (GCC) 4.8.2
!Spherical Harmonic Bayesian Analysis testbed for Lagrangian Dynamical Monte Carlo
program sha_analysis
use sha_helper
implicit none
!Analysis Parameters
integer, parameter :: harm_order = 6
integer, parameter :: harm_array_length = (harm_order+1)**2
real, parameter :: coeff_lo = -0.1, coeff_hi = 0.1, data_err = 0.01 !for now, data_err fixed rather than heirarchical
!Monte Carlo Parameters
integer, parameter :: run = 100000, burn = 50000, thin = 100
real, parameter :: L = 1.0, e = 1.0
!Variables needed by the program
integer :: points, r, h, p, counter = 1
real, dimension(:), allocatable :: x, y, z
real, dimension(harm_array_length) :: l_index_list, m_index_list
real, dimension(:,:), allocatable :: g_matrix
!Open the file, allocate the x,y,z arrays and read the file
open(1, file = 'Average_H_M_C_PcP_boschi_1200.xyz', status = 'old')
read(1,*) points
allocate(x(points))
allocate(y(points))
allocate(z(points))
print *, "Number of Points: ", points
readloop: do r = 1, points
read(1,*) x(r), y(r), z(r)
end do readloop
!Set up the forwards model
allocate(g_matrix(harm_array_length,points))
!Generate the l and m values of spherical harmonics
hloop: do h = 0, harm_order
ploop: do p = -h,h
l_index_list(counter) = h
m_index_list(counter) = p
counter = counter + 1
end do ploop
end do hloop
print *, plgndr(1,2,0.1)
!print *, ylm(1,1,0.1,0.1)
end program sha_analysis
Your program does what is known as recursive IO - the initial call to plgndr is in the output item list of an IO statement (a print statement) [directing output to the console] - inside that function you then also attempt to execute another IO statement [that outputs to the console]. This is not permitted - see 9.11p2 and p3 of F2003 or 9.12p2 of F2008.
A solution is to separate the function invocation from the io statement in the main program, i.e.
REAL :: a_temporary
...
a_temporary = plgndr(1,2,0.1)
PRINT *, a_temporary
Other alternatives in F2008 (but not F2003 - hence the [ ] parts in the first paragraph) include directing the output from the function to a different logical unit (note that WRITE (*, ... and PRINT ... reference the same unit).
In F2008 you could also replace the WRITE statement with a STOP statement with a message (the message must be a constant - which wouldn't let you report the problematic values).
The potential for inadvertently invoking recursive IO is part of the reason that some programming styles discourage conducting IO in functions.
Try:
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
stop
else
...
end if

Constructor of derived types

I am trying to write a constructor for a derived type of an abstract one to solve this other question, but it seems that it's not working, or better, it isn't called at all.
The aim is to have a runtime polymorphism setting the correct number of legs of an animal.
These are the two modules:
animal
module animal_module
implicit none
type, abstract :: animal
private
integer, public :: nlegs = -1
contains
procedure :: legs
end type animal
contains
function legs(this) result(n)
class(animal), intent(in) :: this
integer :: n
n = this%nlegs
end function legs
cat
module cat_module
use animal_module, only : animal
implicit none
type, extends(animal) :: cat
private
contains
procedure :: setlegs => setlegs
end type cat
interface cat
module procedure init_cat
end interface cat
contains
type(cat) function init_cat(this)
class(cat), intent(inout) :: this
print *, "Cat!"
this%nlegs = -4
end function init_cat
main program
program oo
use animal_module
use cat_module
implicit none
type(cat) :: c
type(bee) :: b
character(len = 3) :: what = "cat"
class(animal), allocatable :: q
select case(what)
case("cat")
print *, "you will see a cat"
allocate(cat :: q)
q = cat() ! <----- this line does not change anything
case default
print *, "ohnoes, nothing is prepared!"
stop 1
end select
print *, "this animal has ", q%legs(), " legs."
print *, "cat animal has ", c%legs(), " legs."
end program
The constructor isn't called at all, and the number of legs still remains to -1.
The available non-default constructor for the cat type is given by the module procedure init_cat. This function you have defined like
type(cat) function init_cat(this)
class(cat), intent(inout) :: this
end function init_cat
It is a function with one argument, of class(cat). In your later reference
q = cat()
There is no specific function under the generic cat which matches that reference: the function init_cat does not accept a no-argument reference. The default structure constructor is instead used.
You must reference the generic cat in a way matching your init_cat interface to have that specific function called.
You want to change your init_cat function to look like
type(cat) function init_cat()
! print*, "Making a cat"
init_cat%nlegs = -4
end function init_cat
Then you can reference q=cat() as desired.
Note that in the original, you are attempting to "construct" a cat instance, but you aren't returning this constructed entity as the function result. Instead, you are modifying an argument (already constructed). Structure constructors are intended to be used returning such useful things.
Note also that you don't need to
allocate (cat :: q)
q = cat()
The intrinsic assignment to q already handles q's allocation.
FWIW, here is some sample code comparing three approaches (method = 1: sourced allocation, 2: polymorphic assignment, 3: mixed approach).
module animal_module
implicit none
type, abstract :: animal_t
integer :: nlegs = -1
contains
procedure :: legs !! defines a binding to some procedure
endtype
contains
function legs(this) result(n)
class(animal_t), intent(in) :: this
!! The passed variable needs to be declared as "class"
!! to use this routine as a type-bound procedure (TBP).
integer :: n
n = this % nlegs
end
end
module cat_module
use animal_module, only : animal_t
implicit none
type, extends(animal_t) :: cat_t
endtype
interface cat_t !! overloads the definition of cat_t() (as a procedure)
module procedure make_cat
end interface
contains
function make_cat() result( ret ) !! a usual function
type(cat_t) :: ret !<-- returns a concrete-type object
ret % nlegs = -4
end
end
program main
use cat_module, only: cat_t, animal_t
implicit none
integer :: method
type(cat_t) :: c
class(animal_t), allocatable :: q
print *, "How to create a cat? [method = 1,2,3]"
read *, method
select case ( method )
case ( 1 )
print *, "1: sourced allocation"
allocate( q, source = cat_t() )
!! An object created by a function "cat_t()" is used to
!! allocate "q" with the type and value taken from source=.
!! (Empirically most stable for different compilers/versions.)
case ( 2 )
print *, "2: polymorphic assignment"
q = cat_t()
!! Similar to sourced allocation. "q" is automatically allocated.
!! (Note: Old compilers may have bugs, so tests are recommended...)
case ( 3 )
print *, "3: mixed approach"
allocate( cat_t :: q )
q = cat_t()
!! First allocate "q" with a concrete type "cat_t"
!! and then assign a value obtained from cat_t().
case default ; stop "unknown method"
endselect
c = cat_t()
!! "c" is just a concrete-type variable (not "allocatable")
!! and assigned with a value obtained from cat_t().
print *, "c % legs() = ", c % legs()
print *, "q % legs() = ", q % legs()
end
--------------------------------------------------
Test
$ gfortran test.f90 # using version 8 or 9
$ echo 1 | ./a.out
How to create a cat? [method = 1,2,3]
1: sourced allocation
c % legs() = -4
q % legs() = -4
$ echo 2 | ./a.out
How to create a cat? [method = 1,2,3]
2: polymorphic assignment
c % legs() = -4
q % legs() = -4
$ echo 3 | ./a.out
How to create a cat? [method = 1,2,3]
3: mixed approach
c % legs() = -4
q % legs() = -4
--------------------------------------------------
Side notes
* It is also OK to directly use make_cat() to generate a value of cat_t:
e.g., allocate( q, source = make_cat() ) or q = make_cat().
In this case, we do not need to overload cat_t() via interface.
* Another approach is to write an "initializer" as a type-bound procedure,
and call it explicitly as q % init() (after allocating it via
allocate( cat_t :: q )). If the type contains pointer components,
this approach may be more straightforward by avoiding copy of
components (which can be problematic for pointer components).

I can't figure out how to correctly call the information in my module to the program and make the calculations work?

Basically what I have to do is read in a file called "sounding.txt" that has 100 rows of data. I'm reading that data in and doing different calculations from that data. I'm calculating the freezing level (FRZ), the dew point depression at 700mb (Tdd700), the total totals (TT), the K-Index (KI, and the SWEAT Level (SW). I'm then supposed to output that value into a new data file. The calculations are shown in the code and it seems like most of everything is right but I'm getting a few errors when I compile everything. The terminal errors state that the symbol "Tdd700" conflicts with the symbol from the module "soundingcalcs", that the symboll "T700" has no IMPLICIT type, that the symbol "Td700" has no IMPLICIT type, and that there's a rank mismatch in my argument "T850" at "KI=ki_calc(sounding)". I'm not sure what I'm doing wrong and I would appreciate any help or advice.
My module:
MODULE soundingcalcs
IMPLICIT NONE
REAL :: Tdd700, TT, T850, T500, Td850, T700, Td700
REAL :: V850, V500, dd500, dd850
contains
! This is where the internal module is located
!##################################################################
!This functions will calculate the K-Index.
!
!Accepts: temperature and dew point at different levels
!Returns: KI-Index
!#################################################################
FUNCTION ki_calc(T850,T500,Td850,Tdd700)
! Calculate K-Index
REAL, INTENT(IN) :: T850,T500,Td850,Tdd700
REAL:: ki_calc
ki_calc=((T850)-(T500))+(Td850)-(Tdd700)
END FUNCTION ki_calc
!################################################################
!This subroutine will calculate the SWEAT Index
!
!Accepts: Total Totals, wind speed, dew point, and temperature
!Returns: SWEAT Index value
!################################################################
SUBROUTINE sw_calc(Td850,TT,V850,V500,dd500,dd850)
! Calculate SWEAT Index
REAL, INTENT(IN):: Td850,V850,V500,dd500,dd850
REAL:: sw_value, TT
sw_value=12.0*(Td850)+20.0*((TT)-49.0)+2.0*(V850) &
+(V500)+125.0*(sin((dd500)-(dd850))+0.2)
END SUBROUTINE sw_calc
END MODULE soundingcalcs
My main program:
USE soundingcalcs
IMPLICIT NONE
CHARACTER(20), PARAMETER :: datafile = "sounding.txt"
CHARACTER(20), PARAMETER :: outfile = "hw9_NEIFERT.out"
CHARACTER(3) :: stname
REAL :: lat, long, elev, pres, temp, dewp, winddir, sw_value
REAL :: windspd, FRZ=0, MW=0, windmax, Td500, SW, KI
REAL :: T700, Td700, Tdd700, TT850, T500, Td850
REAL, DIMENSION(5,100) :: sounding
REAL, PARAMETER :: pi = 3.14159
INTEGER :: OpenStat=0, InputStat=0, day, mth, yr, hr, stnum
INTEGER :: count=0, i, j, log=0
INTEGER, PARAMETER :: flag = -999
sounding=flag
! Open the GEMPAK sounding file
open (unit=2, file=datafile, status="old", iostat=OpenStat)
IF (OpenStat > 0) STOP "Can't open file"
! Read in header and then read in data as array
read (unit=2, FMT="(8x,A3,15x,I8,10x,I2,I2,I2,1x,I4)") &
stname, stnum, yr, mth, day, hr
read (unit=2, FMT="(8x,F6.2,14x,F6.2,10x,F7.1)") &
lat, long, elev
read (unit=2, FMT="(////)")
read (unit=2, FMT=*, iostat=InputStat) sounding
! Set counter and maximum wind speed
DO i=1,100
temp=sounding(2,i)
IF (temp==flag) EXIT
count=count+1
END DO
windmax=MAXVAL(sounding(5,:))
! Find temp, dew point, wind speed, directions
DO j=1, count
pres=sounding(1,j)
temp=sounding(2,j)
dewp=sounding(3,j)
winddir=sounding(4,j)
windspd=sounding(5,j)
IF (temp <= 0 .AND. log == 1) THEN
FRZ=pres
log=2
END IF
IF (pres == 850) THEN
T850=temp
Td850=dewp
V850=windspd
dd850=(((winddir)*(pi))/(180))
END IF
IF (pres == 700) THEN
T700=temp
Td700=dewp
END IF
IF (pres == 500) THEN
T500=temp
Td500=dewp
V500=windspd
dd500=(((winddir)*(pi))/(180))
END IF
IF (windspd==windmax) MW=pres
END DO
! Calculate 700 millibars dew point depression
Tdd700=(T700)-(Td700)
! Calculate the Total Totals
TT=((T850)-(T500))+((Td850)-(T500))
! Convert function and subroutine module subprograms into working
! output values
KI=ki_calc(sounding)
! Open a file to output data
open (unit=3, file=outfile, status="new", iostat=OpenStat)
IF (OpenStat > 0) STOP "Cannot open file"
! Output header and values
write (unit=3, FMT="(6x,A15,4x,A3,10x,A11,1x,I8)") "Station ID:", &
stname, "Station #:", stnum
write (unit=3, FMT="(6x,A15,2x,I2,A1,I2,A1,I2,7x,A11,1x,I4,1x,A3)") &
"Date(MM/DD/YY):", mth, "/", day, "/", yr, "Time:", hr, "Z"
write (unit=3, FMT="(/A10,1x,F6.2,1x,A3,3x,A11,1x,F6.2,1x,A3,3x,&
A11,1x,F8.2,1x,A1)")"Latitude:", lat, "deg", "Longitude:", long, "deg",&
"Elevation:", elev, "m"
write (unit=3, FMT="(/A16,1x,F6.2,1x,A2)") "Freezing Level:",FRZ,"mb"
write (unit=3, FMT="(A16,1x,F6.2,1x,A38)") "Total Totals:", TT
write (unit=3, FMT="(A16,1x,F6.2,1x,A38)") "K-Index:",KI
write (unit=3, FMT="(A16,1x,F6.2,1x,A2)") "SWEAT Index:", sw_value
write (unit=3, FMT="(A16,1x,F6.2,1x,A2)") "Max Wind Level:", MW, "mb"
! Close files
close(3)
close(2)
END PROGRAM sound_calc
If you use the module, you import all its procedures, types, and variables.
So the error
REAL :: T700, Td700, Tdd700, TT850, T500, Td850
1
sounding.f90:2.4:
USE soundingcalcs
2
Error: Symbol 't700' at (1) conflicts with symbol from module 'soundingcalcs',
use-associated at (2)
tells you that you declare a variable name that has already been taken by another variable in the module.
Either declare the variable only in the module, don't import it, or if you need a different variable, give it a different name.
So, for example, you have:
module my_mod
implicit none
real :: a = 1.0
contains
function get_a()
real :: get_a
get_a = a
end function get_a
end module my_mod
Then, if you only need the procedure, you can only import that:
program my_prog
use my_mod, only: get_a
real :: a
a = 3e2
print *, a
print *, get_a()
end program my_prog
If you need a variable called a in your main program, and it needs to be different to the module's variable, and you need access to that module's variable as well, you can do something like this:
program my_prog
use my_mod, only: get_a, b=>a
implicit none
real :: a
a = 1.0
b = 2.0
print *, a, get_a()
end program my_prog
The second error is due to a rank-mismatch, simply put: The function ki_calc expects 4 arguments of scalar type real. But sounding, which you supply as the only argument, is a 2-d array with shape (5, 100)
I don't know what you want, but maybe something like
KI=ki_calc(sounding(1, 1), sounding(2, 1), sounding(3, 1), sounding(4, 1))
(This would indicate that T850 == sounding(1, 1) and T500 == sounding(2, 1) and so on.)

Function with more arguments and integration

I have I simple problem but I cannot find a solution anywhere.
I have to integrate a function (for example using a Simpson's rule subroutine) but I am obliged to pass to my function more than one argument: one is the variable that I want to integrate later and another one is just a value coming from a different calculation which I cannot perform inside the function.
The problem is that the Simpson subroutine only accept f(x) to perform the integral and not f(x,y).
After Vladimir suggestions I modified the code.
Below the example:
Program main2
!------------------------------------------------------------------
! Integration of a function using Simpson rule
! with doubling number of intervals
!------------------------------------------------------------------
! to compile:
! gfortran main2.f90 -o simp2
implicit none
double precision r, rb, rmin, rmax, rstep, integral, eps
double precision F_int
integer nint, i, rbins
double precision t
rbins = 4
rmin = 0.0
rmax = 4.0
rstep = (rmax-rmin)/rbins
rb = rmin
eps = 1.0e-8
func = 0.0
t=2.0
do i=1,rbins
call func(rb,t,res)
write(*,*)'r, f(rb) (in main) = ', rb, res
!test = F_int(rb)
!write(*,*)'test F_int (in loop) = ', test
call simpson2(F_int(rb),rmin,rb,eps,integral,nint)
write(*,*)'r, integral = ', rb, integral
rb = rb+rstep
end do
end program main2
subroutine func(x,y,res)
!----------------------------------------
! Real Function
!----------------------------------------
implicit none
double precision res
double precision, intent(in) :: x
double precision y
res = 2.0*x + y
write(*,*)'f(x,y) (in func) = ',res
return
end subroutine func
function F_int(x)
!Function to integrate
implicit none
double precision F_int, res
double precision, intent(in) :: x
double precision y
call func(x,y,res)
F_int = res
end function F_int
Subroutine simpson2(f,a,b,eps,integral,nint)
!==========================================================
! Integration of f(x) on [a,b]
! Method: Simpson rule with doubling number of intervals
! till error = coeff*|I_n - I_2n| < eps
! written by: Alex Godunov (October 2009)
!----------------------------------------------------------
! IN:
! f - Function to integrate (supplied by a user)
! a - Lower limit of integration
! b - Upper limit of integration
! eps - tolerance
! OUT:
! integral - Result of integration
! nint - number of intervals to achieve accuracy
!==========================================================
implicit none
double precision f, a, b, eps, integral
double precision sn, s2n, h, x
integer nint
double precision, parameter :: coeff = 1.0/15.0 ! error estimate coeff
integer, parameter :: nmax=1048576 ! max number of intervals
integer n, i
! evaluate integral for 2 intervals (three points)
h = (b-a)/2.0
sn = (1.0/3.0)*h*(f(a)+4.0*f(a+h)+f(b))
write(*,*)'a, b, h, sn (in simp) = ', a, b, h, sn
! loop over number of intervals (starting from 4 intervals)
n=4
do while (n <= nmax)
s2n = 0.0
h = (b-a)/dfloat(n)
do i=2, n-2, 2
x = a+dfloat(i)*h
s2n = s2n + 2.0*f(x) + 4.0*f(x+h)
end do
s2n = (s2n + f(a) + f(b) + 4.0*f(a+h))*h/3.0
if(coeff*abs(s2n-sn) <= eps) then
integral = s2n + coeff*(s2n-sn)
nint = n
exit
end if
sn = s2n
n = n*2
end do
return
end subroutine simpson2
I think I'm pretty close to the solution but I cannot figure it out...
If I call simpson2(F_int, ..) without putting the argument in F_int I receive this message:
call simpson2(F_int,rmin,rb,eps,integral,nint)
1
Warning: Expected a procedure for argument 'f' at (1)
Any help?
Thanks in advance!
Now you have a code we can work with, good job!
You need to tell the compiler, that F_int is a function. That can be done by
external F_int
but it is much better to learn Fortran 90 and use modules or at least interface blocks.
module my_functions
implicit none
contains
subroutine func(x,y,res)
!----------------------------------------
! Real Function
!----------------------------------------
implicit none
double precision res
double precision, intent(in) :: x
double precision y
res = 2.0*x + y
write(*,*)'f(x,y) (in func) = ',res
return
end subroutine func
function F_int(x)
!Function to integrate
implicit none
double precision F_int, res
double precision, intent(in) :: x
double precision y
call func(x,y,res)
F_int = res
end function F_int
end module
Now you can easily use the module and integrate the function
use my_functions
call simpson2(F_int,rmin,rb,eps,integral,nint)
But you will find that F_int still does not know what y is! It has it's own y with undefined value! You should put y into the module instead so that everyone can see it.
module my_functions
implicit none
double precision :: y
contains
Don't forget to remove all other declarations of y! Both in function F_int and in the main program. Probably it is also better to call it differently.
Don't forget to set the value of y somewhere inside your main loop!