Related
I am working with a FEM program written in Fortran language. It is a mechanical analysis that involves multiple set of material. The important variables are saved into modules that have the following form
MODULE element
implicit none
save
TYPE proel_type
INTEGER:: prop1
INTEGER:: prop2
REAL:: prop3
REAL:: prop4
...
INTEGER, ALLOCATABLE :: list1(:)
REAL, ALLOCATABLE :: array1(:)
...
INTEGER:: LTYPE
...
END TYPE proel_type
TYPE(proel_type), ALLOCATABLE:: proel(:)
INTEGER:: prop1
INTEGER:: prop2
REAL:: prop3
REAL:: prop4
...
INTEGER:: LTYPE
INTEGER:: ISETS
...
END MODULE element
As you can see, proel is an allocatable data structure that contains some information about the properties of the material, the element and so on. This data is taken from a text file through a I/O routine like
SUBROUTINE setdata
USE element
IMPLICIT NONE
ALLOCATE(PROEL(NSETS))
DO ISETS=1,NSETS
... ! here I am loading succefully the string variable STRVAR
! from the text file with data
LTYPE=GETVAL(STRVAR) ! here I retreive the value of LTYPE
PROEL(ISETS)%LTYPE=LTYPE ! here I save the (integer) variable for the set
IF(LTYPE.NE.0)THEN
CALL SETELM
END IF
END DO
END SUBROUTINE
Inside subroutine SETELM I am setting some particular parameters used in the program, but at some point I recall LTYPE saved in PROEL
SUBROUTINE SETELM
USE element
IMPLICIT NONE
LTYPE=PROEL(ISETS)%LTYPE
SELECT CASE(LTYPE)
CASE( 1)
...
CASE( 2)
...
CASE DEFAULT
...
END SELECT
END SUBROUTINE
Now, between the assignment LTYPE=PROEL(ISETS)%LTYPE and the SELECT CASE(LTYPE), the variable LTYPE changes value without any reason. The value is random (in the sense that I do not know where it comes from but it is not like uninitialized vars) and there are no others operations in the middle that work with LTYPE.
I am working with VS2008 and Fortran, so I turned on every warning, but neither compilation nor runtime give some possible hint.
Do you have any idea why is that happening?
The code is here:
interface
subroutine csrcoo (nrow,job,nzmax,a,ja,ia,nnz,ao,ir,jc,ierr) bind(c,name="CSRCOO")
use iso_c_binding
implicit none
integer(c_int), value :: nrow,job,nzmax,nnz
real(c_double) :: a(*),ao(*)
integer(c_int) :: ir(*),jc(*),ja(*),ia(nrow+1),ierr
end subroutine csrcoo
end interface
subroutine csrcoo (nrow,job,nzmax,a,ja,ia,nnz,ao,ir,jc,ierr)
integer :: nrow,job,nzmax,nnz
real*8 :: a(*),ao(*)
integer :: ir(*),jc(*),ja(*),ia(nrow+1),ierr
integer :: i,k,k1,k2
ierr = 0
nnz = ia(nrow+1)-1
if (nnz > nzmax) then
ierr = 1
return
endif
goto (3,2,1) job
1 do 10 k=1,nnz
ao(k) = a(k)
10 END DO
2 do 11 k=1,nnz
jc(k) = ja(k)
11 END DO
3 do 13 i=nrow,1,-1
k1 = ia(i+1)-1
k2 = ia(i)
do 12 k=k1,k2,-1
ir(k) = i
12 END DO
13 END DO
return
end subroutine csrcoo
When I use the gfortran to compile this code like this: gfortran -O2 -c test.f90
It always shows this error:
test.f90:11:
subroutine csrcoo (nrow,job,nzmax,a,ja,ia,nnz,ao,ir,jc,ierr)
1
Error: Unclassifiable statement at (1)
test.f90:41.3:
end subroutine csrcoo
1
Error: Expecting END PROGRAM statement at (1)
Error: Unexpected end of file in 'test.f90'
Can anyone tell me what wrong with that code and give me some advice?
The problem is, that a standalone interface doesn't make any sense, because its name has to be accessible inside the part of the program, where you want to use it. Therefore, it has to be defined inside a module or a program.
I think, the error stems from the fact, that the program statement is not necessary and your interface, therefor, implicitely defines a program, which should be ended with an end statement, which is obviously missing.
You can solve your problem by wrapping your interface in a module and leaving the subroutine out of the module (otherwise, your subroutine would already have a module interface).
module [name]
[your interface]
end module
[your subroutine]
EDIT (Suggestion form #HighPerformanceMark): The better solution for the code you showed us would be to put the subroutine itself into the module and delete the interface. In this case, the interface for the subroutine is created automatically and you don't have to care for it.
module [name]
use iso_c_binding
implicit none
subroutine csrcoo (nrow,job,nzmax,a,ja,ia,nnz,ao,ir,jc,ierr) bind(c,name="CSRCOO")
[the content of your subroutine]
end subroutine
end module
I'm trying to write a time variable from a hydrodynamic model into a netcdf file (unlimited dimension variable). I've attached a simplified code example in Fortran90 that highlights my issue.
The subroutine to write the netcdf file is called multiple times during a simulation depending on a user specified output interval (10 times for this example). I can create the file and add attributes for the first time the subroutine is called.
I can't get the start and count variables correct to write the time variable to the file during the subsequent calls of the subroutine. This is the error, at the writing the model time variable, I receive when trying to compile the code: Error: There is no specific function for the generic 'nf90_put_var'
PROGRAM test_netcdf
IMPLICIT NONE
INTEGER :: N
REAL :: time_step = 2.
! Call efdc_netcdf 10 times
DO N=1,10
CALL efdc_netcdf(N, time_step)
time_step=time_step + 1.
ENDDO
END PROGRAM test_netcdf
************************************
! Create NetCDF file and write variables
SUBROUTINE efdc_netcdf(N, time_step)
USE netcdf
IMPLICIT NONE
LOGICAL,SAVE::FIRST_NETCDF=.FALSE.
CHARACTER (len = *), PARAMETER :: FILE_NAME = "efdc_test.nc"
INTEGER :: ncid, status
INTEGER :: time_dimid
INTEGER :: ts_varid, time_varid
INTEGER :: start(1), count(1)
INTEGER :: deltat
INTEGER :: N
REAL :: time_step
start=(/N/)
count=(/1/)
! Create file and add attributes during first call of efdc_netcdf
IF(.NOT.FIRST_NETCDF)THEN
status=nf90_create(FILE_NAME, NF90_CLOBBER, ncid)
! Define global attributes once
status=nf90_put_att(ncid, NF90_GLOBAL, 'format', 'netCDF-3 64bit offset file')
status=nf90_put_att(ncid, NF90_GLOBAL, 'os', 'Linux')
status=nf90_put_att(ncid, NF90_GLOBAL, 'arch', 'x86_64')
! Define deltat variable
status=nf90_def_var(ncid,'deltat',nf90_int,ts_varid)
! Define model time dimension
status=nf90_def_dim(ncid,'efdc_time',nf90_unlimited,time_dimid)
! Define model time variable
status=nf90_def_var(ncid,'efdc_time',nf90_real,time_dimid,time_varid)
status=nf90_enddef(ncid)
! Put deltat during first call
deltat=7
status=nf90_put_var(ncid, ts_varid, deltat)
FIRST_NETCDF=.TRUE.
ENDIF
! Put model time variable
status=nf90_put_var(ncid, time_varid, time_step, start=start, count=count)
! Close file at end of DO loop
IF(N.EQ.10) THEN
status=nf90_close(ncid)
ENDIF
RETURN
END SUBROUTINE efdc_netcdf
The issue is in the line the compiler flags:
status=nf90_put_var(ncid, time_varid, time_step, start=start, count=count)
You are (correctly) trying to write a scalar variable, time_step, into a specific index (start) along variable time_varid, which is defined on a 1-d, infinite-extent dimension. However, in this case, the optional argument count isn't meaningful; you are writing the scalar, and count can only ever be 1. As a result, the fortran bindings for a nf90_put_var() taking a single scalar for input don't have the optional argument defined for count, and that's why you're getting the "no specific function for the generic' nf90_put_var" error from the compiler. This is all perfectly reasonable, but neither the error message nor the docs are super helpful in figuring out how to solve the problem.
You can fix your code by putting the time_step data into a real, dimension(1) variable, and putting that, instead; but easiest is to just get rid of the count specification, which isn't necessary here anyway:
status=nf90_put_var(ncid, time_varid, time_step, start=start)
Is there a way to call the field of a derived type via string argument in fortran?
something like...
subroutine set(car, fieldName, value)
type(Car_T) :: car
character*(*) :: fieldName
character*(*) :: value
car%[fieldName] = value
end subroutine set
I know you can do stuff like this in javascript, c#, ect., but this could really help me from having a ton of duplicate code if fortran allows it.
No. You will need to write the executable code (perhaps a SELECT CASE construct) that maps the value of the string across to the relevant component.
You only need to write this once for each unique set of component names.
You can do something similar with namelists but it is for items known to the program: not new items.
integer:: inin
real:: rere
namelist /info/ inin, rere
inin = 0 ! default
rere = 20.4 ! default
read (*, nml=info)
print *, 'inin=', inin
print *, 'rere=', rere
stop
end
On the input
&info inin=2 rere=40.0 /
Or if you wish to input one value only
&info rere=3.162 /
I want to wrap the fortran write-statement in a custom subroutine or function which includes some additional debug-logic.
But I'm currently stuck with defining the prototype of the function/subroutine.
Is this possible? If yes, how?
The title of your question exhibits a misunderstanding, though the text suggests you know better. Nevertheless, for the record, write is a Fortran statement, it is neither a subroutine nor a function.
I think you have a number of options. One, which I have used occasionally, would be to write a function which returns a string. Perhaps
function error_message(error)
character(len=*), intent(in) :: error
character(len=:), allocatable :: error_message
error_message = 'ERROR: '//trim(error)
end function error_message
which you can then use like this
write(*,*) error_message('Oh s**t')
You could certainly write a subroutine or a function with side effects which include writing to an ouput channel, but if you adopt this approach you have to be careful to observe the rules for recursive i/o.
EDIT
after OP's comment.
If you want to switch off debug messages another option you have is to direct them to a null device or file, eg /dev/null on Linux or NUL on Windows. Something like
integer, parameter :: debug_channel = 99
logical, parameter :: debugging = .false.
...
if (debugging) then
open(debug_channel, file='NUL')
else
open(debug_channel, file='debuglog'
end if
and then
write(debug_channel,*) 'message'
a relatively simple way to accomplish most of what you want is to simply put the if inline in front of every write that is subject to debug control:
if(debug)write(..,..)..
where debug is a global logical value, or even:
if(debugf(level))write(..,..)..
where the logical function debugf determines whether to write based on some argument.
In addition to the other answers, you may be able to avoid using if (debug) write... with derived type IO.
I say "may", as it is quite silly unless you already have a suitable structure, and compiler support is currently rare.
However, as an example, compiled with ifort 14.0.1:
module errormod
type error_t
character(len=:), allocatable :: message
contains
procedure write_error
generic :: write(formatted) => write_error
end type error_t
logical debug_verbose
contains
subroutine write_error(err, unit, iotype, v_list, iostat, iomsg)
class(error_t), intent(in) :: err
integer, intent(in) :: unit
character(len=*), intent(in) :: iotype
integer, intent(in), dimension(:) :: v_list
integer, intent(out) :: iostat
character(len=*), intent(inout) :: iomsg
if (debug_verbose) then
write(unit, '("Error: ", A)', iostat=iostat, iomsg=iomsg) err%message
else
write(unit, '()', advance='no')
end if
end subroutine write_error
end module errormod
program test
use errormod
implicit none
type(error_t) error
debug_verbose = .TRUE.
error%message = "This error will be reported."
write(*, '(dt)') error
debug_verbose = .FALSE.
error%message = "This error will not be reported."
write(*, '(dt)') error
debug_verbose = .TRUE.
error%message = "This final error will also be reported."
write(*, '(dt)') error
end program test
The first and third messages will appear, but not the second.