Read dataset of a group of HDF5 using Fortran - fortran

I got stuck with reading the member dataset of a group of a HDF5 file using Fortran.
I am able to list the member of a group of my HDF5. But I am not able to access the data of a member in the group,
program sds_info
use hdf5
implicit none
! Variables declaration
CHARACTER*100 :: file_name
CHARACTER*100 :: sds_name
CHARACTER*100 :: gr_name
INTEGER(HID_T):: file_id, gr_id, dset_id, attr_id
INTEGER :: status, error, storage, nlinks,max_corder, attr_num
REAL, DIMENSION(1) :: dset_data, data_out
INTEGER, DIMENSION(1) :: buf
INTEGER(HSIZE_T), DIMENSION(1):: data_dims
INTEGER(HSIZE_T), DIMENSION(1) ::dims
!
! varaibles to read a dataset in a group
CHARACTER*100 :: ap_name
integer(HID_T):: ap_id
real, allocatable, dimension(:) :: ap
integer(HSIZE_T), dimension(15624960) :: ap_dim
integer :: nmembers ! Number of group members
CHARACTER(LEN=20) :: name_buffer ! Buffer to hold object's name
integer :: i
integer :: type
!
! Variables initalization
file_name = "PVAR8.h5"
sds_name = "time"
gr_name = "part"
attr_name = "attr1"
ap_name="ap"
! Initialize the interface
call h5open_f(status)
! Open an hdf5 file
call h5fopen_f(file_name, H5F_ACC_RDWR_F, file_id, status)
! Open a group
call h5gopen_f(file_id, gr_name, gr_id, status )
!
! Open a dataset
call h5dopen_f(file_id, sds_name, dset_id, error)
! Get the number of attributes
call h5aget_num_attrs_f(dset_id, attr_num, error)
print *, "attr_num ",attr_num
! Read the dataset
call h5dread_f(dset_id, H5T_NATIVE_REAL, data_out, data_dims, error)
print *, "data_out ",data_out
! Terminate access to the group
call h5gclose_f(gr_id, error)
! Terminate access to the dataset
call h5dclose_f(dset_id, error)
! Terminate access to the file
call h5fclose_f(file_id, error)
! Close FORTRAN interface.
call h5close_f(status)
end program sds_info
I can read the group but how to access and read the data of a member of a group in HDF5 using Fortran?

In case you are not bound to use a specific technology, take a look at HDFql to solve your question.
Using HDFql in Fortran, you can read dataset time (of datatype real) stored in group part from file PVAR8.h5 like the following:
PROGRAM Test
! use HDFql module (make sure it can be found by the Fortran compiler)
USE HDFql
! declare variables
REAL(KIND = 8) :: value
INTEGER :: state
! register variable "value" for subsequent use (by HDFql)
state = hdfql_variable_transient_register(value)
! select (i.e. read) data from dataset "time" and populate variable "value" with it
state = hdfql_execute("SELECT FROM PVAR8.h5 /part/time INTO MEMORY 0")
! display content of variable "value"
WRITE(*, *) "Dataset value:", value
END PROGRAM
Additional HDFql examples can be found here.

Related

Write in a new line on every write(33,*) comand in Fortran77

I create a fortran code to calculate the temperature of a cfd model. This code will be called on every iteration of a steady state simulation and calculate the temperature. On every calling of my code/iteration i want my fortran code also save the temperature field on a txt file and save. After calculating the temperature field and saving the values in TFIELD(100;1:6) the part with saving in txt file looks like:
OPEN(UNIT=35,FILE='W:\temperaturField.txt',
&FORM ='FORMATTED',STATUS='UNKNOWN',
&ACTION='READWRITE')
WRITE (35,FMT='5(F8.3,2X))') TFIELD(100,1:6)
With this code it only overwrites the first line of my txt file on every iteration. But i want to paste every TFIELD(100,1:6) array on a new line. How can i do this?
Add POSTITION='APPEND' to the OPEN:
OPEN(UNIT=35,FILE='W:\temperaturField.txt',
&FORM ='FORMATTED',STATUS='UNKNOWN',POSITION='APPEND',
&ACTION='READWRITE')
It seems like you are opening and closing the file for each iteration. This is a quick and dirty method if you need to debug, but it's slow.
If you want to do that, you might want to do what #Jack said: Include a POSITION='APPEND' to the OPEN statement to set the position to write the data to the end of the file. Also, you need to make sure that you close it every time.
A better (more efficient) method would be to keep the file open for the whole time. I'd do that with a module:
module temp_writer_module
implicit none
integer :: temp_writer_unit
logical :: is_opened = .FALSE.
private :: temp_writer_unit, is_opened
contains
subroutine temp_writer_open()
integer :: ios
character(len=100) :: iomsg
if (is_opened) then
print*, "Warning: Temperature file already openend"
return
end if
open(newunit=temp_writer_unit, file='W:\temperatureField', &
form='FORMATTED', status='UNKNOWN', action='WRITE', &
iostat=ios, iomsg=iomsg)
if (ios /= 0) then
print*, "Error opening temperature file:"
print*, trim(iomsg)
STOP
end if
is_opened = .TRUE.
end subroutine temp_writer_open
subroutine temp_writer_close()
if (.not. is_opened) return
close(temp_writer_unit)
is_opened = .FALSE.
end subroutine temp_writer_close
subroutine temp_writer(temps)
real, intent(in) :: temps(6)
integer :: ios
character(len=100) :: iomsg
if (.not. is_opened) call temp_writer_open()
write(temp_writer_unit, *, iostat=ios, iomsg=iomsg) temps
if (ios /= 0) then
print*, "Error writing to temperature file:"
print*, trim(iomsg)
end if
end subroutine temp_writer
end module temp_writer_module
Then you can use it in your program like this:
subroutine calc_temps(...)
use temp_writer_module
<variable declarations>
<calculations>
call temp_writer(tfield(100, 1:6))
end subroutine calc_temps
Just don't forget to call the temp_writer_close routine before your program ends.

Saved variable in Module changes value when recalled in subroutine

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?

Writing a scalar variable along an unlimited dimension in NetCDF

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)

How to wrap the fortran write-statement

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.

unpacking data using a fortran code

i'm a grad student trying to work with atmospheric data files provided by NOAA. I have a code that reads the data but only writes the first four columns of data. I know that the subroutine at the end of the code unpacks the data. I was thinking maybe if I take out the conditional statements then it might write the entire data. But that doesn't work. I need to develop this code so that it writes the entire data file and not just the first four elements. Any help is appreciated. The code is shown below:
PROGRAM CHK_DATA
!-------------------------------------------------------------------------------
! Simple program to dump the first few elements of the data array for each
! record of an ARL packed meteorological file. Used for diagnostic testing.
! Created: 23 Nov 1999 (RRD)
! 14 Dec 2000 (RRD) - fortran90 upgrade
! 18 Oct 2001 (RRD) - expanded grid domain
! 03 Jun 2008 (RRD) - embedded blanks
!-------------------------------------------------------------------------------
REAL, ALLOCATABLE :: RDATA(:,:)
CHARACTER(1), ALLOCATABLE :: CPACK(:)
CHARACTER(4) :: KVAR, MODEL
CHARACTER(50) :: LABEL
CHARACTER(80) :: FDIR, FILE
CHARACTER(3072) :: HEADER
LOGICAL :: FTEST
!-------------------------------------------------------------------------------
INTERFACE
SUBROUTINE UNPACK(CPACK,RDATA,NX,NY,NEXP,VAR1)
CHARACTER(1),INTENT(IN) :: CPACK(:)
REAL, INTENT(OUT) :: RDATA(:,:)
INTEGER, INTENT(IN) :: NX,NY,NEXP
REAL, INTENT(IN) :: VAR1
END SUBROUTINE
END INTERFACE
!-------------------------------------------------------------------------------
! directory and file name
WRITE(*,*)'Enter directory name:'
READ(*,'(a)')FDIR
FDIR=ADJUSTL(FDIR)
WRITE(*,*)'Enter file name:'
READ(*,'(a)')FILE
FILE=ADJUSTL(FILE)
! test for meteo file existence
KLEN=LEN_TRIM(FDIR)
INQUIRE(FILE=FDIR(1:KLEN)//FILE,EXIST=FTEST)
IF(.NOT.FTEST)THEN
WRITE(*,*)'Unable to find file: ',FILE
WRITE(*,*)'On local directory : ',FDIR(1:KLEN)
STOP
END IF
! open file to decode the standard label (50) plus the
! fixed portion (108) of the extended header
OPEN(10,FILE=FDIR(1:KLEN)//FILE,RECL=158,ACCESS='DIRECT',FORM='UNFORMATTED')
! decode the standard portion of the index record
READ(10,REC=1)LABEL,HEADER(1:108)
READ(LABEL,'(5I2,4X,A4)')IYR,IMO,IDA,IHR,IFC,KVAR
WRITE(*,'(A,4I5)')'Opened file : ',IYR,IMO,IDA,IHR
IF(KVAR.NE.'INDX')THEN
WRITE(*,*)'WARNING Old format meteo data grid'
WRITE(*,*)LABEL
WRITE(*,*)HEADER(1:108)
STOP
END IF
! decode extended portion of the header
READ(HEADER(1:108),'(A4,I3,I2,12F7.0,3I3,I2,I4)',ERR=900) &
MODEL, ICX, MN, &
POLE_LAT, POLE_LON, REF_LAT, &
REF_LON, SIZE, ORIENT, &
TANG_LAT, SYNC_XP, SYNC_YP, &
SYNC_LAT, SYNC_LON, DUMMY, &
NX, NY, NZ, &
K_FLAG, LENH
! close file and reopen with proper length
CLOSE (10)
NXY = NX*NY
LEN = NXY+50
OPEN(10,FILE=FDIR(1:KLEN)//FILE,RECL=LEN,ACCESS='DIRECT',FORM='UNFORMATTED')
! print file diagnostic
WRITE(*,'(A,4I5)')'Grid size and lrec: ',NX,NY,NXY,LEN
WRITE(*,'(A,I5)') 'Header record size: ',LENH
! allocate array space
ALLOCATE (RDATA(NX,NY), STAT=KRET)
ALLOCATE (CPACK(NXY), STAT=KRET)
! read entire file and print headers
KREC=1
100 READ(10,REC=KREC,ERR=800)LABEL,(CPACK(K),K=1,NXY)
READ(LABEL,'(6I2,2X,A4,I4,2E14.7)',ERR=900) IY,IM,ID,IH,IF,KL, &
KVAR,NEXP,PREC,VAR1
WRITE(*,'(A)')LABEL
IF(KVAR.NE.'INDX') CALL UNPACK(CPACK,RDATA,NX,NY,NEXP,VAR1)
READ(*,*,END=800)
KREC=KREC+1
GO TO 100
800 STOP
900 WRITE(*,*)'ERROR: decoding header'
WRITE(*,*)LABEL
WRITE(*,*)HEADER(1:108)
END PROGRAM chk_data
!-------------------------------------------------------------------------------
SUBROUTINE UNPACK(CPACK,RDATA,NX,NY,NEXP,VAR1)
CHARACTER(1),INTENT(IN) :: CPACK(:)
REAL, INTENT(OUT) :: RDATA(:,:)
INTEGER, INTENT(IN) :: NX,NY,NEXP
REAL, INTENT(IN) :: VAR1
! only required when dealing with F95 compilers
! replace ICHAR below with internally defined JCHAR function
! CHARACTER MYCHR*1
! JCHAR(MYCHR)=IAND(ICHAR(MYCHR),255)
SCALE=2.0**(7-NEXP)
VOLD=VAR1
INDX=0
DO J=1,NY
DO I=1,NX
INDX=INDX+1
RDATA(I,J)=(ICHAR(CPACK(INDX))-127.)/SCALE+VOLD
VOLD=RDATA(I,J)
IF(I.LE.2.AND.J.LE.2) &
WRITE(*,'(3I5,E12.4)')J,I,ICHAR(CPACK(INDX)),RDATA(I,J)
IF(I.GE.(NX-1).AND.J.GE.(NY-1)) &
WRITE(*,'(3I5,E12.4)')J,I,ICHAR(CPACK(INDX)),RDATA(I,J)
END DO
VOLD=RDATA(1,J)
END DO
END SUBROUTINE unpack
Did you notice the comment
! only required when dealing with F95 compilers
! replace ICHAR below with internally defined JCHAR function
! CHARACTER MYCHR*1
! JCHAR(MYCHR)=IAND(ICHAR(MYCHR),255)
Try to uncomment the definition, and change the calls to CHAR to calls to JCHAR.
ICHAR is an intrinsic function in Fortran that behaves different, than the code expects. It all seems suspicious, because the JCHAR does nothing to numbers below 256.
For further porting consider using IMPLICIT NONE and modules.
---EDIT ---
Now I see your conditionals. If you remove
IF(I.LE.2.AND.J.LE.2) &
and
IF(I.GE.(NX-1).AND.J.GE.(NY-1)) &
what exactly does the code do? We do not have the data.
(I know, there are a lot of the data files on the page you downloaded your program, but I am not going to the all the work for you, sorry.)
Cant you find a complete code to work with the data anywhere?