Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
28988 Discussions

C_LOC and storage association

Ben3
Beginner
‎02-10-2025 02:30 PM
406 Views

Hi,

I compiled HDF5 with icx/ifx 2024.2.1 with optimisation and found that one of its Fortran 2003 tests failed - the details are in https://github.com/HDFGroup/hdf5/issues/5305.

The issues seems to be in this snippet:

type(s1_t), dimension(:, :), allocatable, target :: rdata
type(c_ptr) :: f_ptr

allocate(rdata(2,2))

f_ptr = C_LOC(rdata(1,1)) 
CALL H5Dread_f(dataset, tid1, f_ptr, error, H5S_ALL_F, H5S_ALL_F, H5P_DEFAULT_F)

DO i = 1, 2
  DO j = 1, 2
    IF(wdata(i,j)%i.ne.rdata(i,j)%i) THEN
      PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
    ENDIF
  ENDDO
ENDDO

The comparisons in line 11 are failing except for the first element, as if it's not seeing data that was read into rdata by the call to H5Dread_f.

Replacing the call to C_LOC(rdata(1,1)) with C_LOC(rdata) solves the problem. As does initialising the whole rdata array after allocating it.

It feels like that the compiler is assuming nothing could have modified the other elements and optimising out the comparisons (as undefined behaviour maybe, since it could be assuming they're uninitialised?), even though the actual data stored there is correct.

The HDF5 team think this might be a compiler bug.

Thanks,
Ben

0 Kudos

Link Copied

4 Replies
Steve_Lionel
Honored Contributor III
‎02-10-2025 03:48 PM
379 Views

That rdata has the target attribute tells the compiler to not make any assumptions. There is not enough code here to even guess what may be going on, since I see no reference to wdata other than in the comparison.

It is easy to test to see if c_loc(rdata) and c_loc(rdata(1,1)) return the same value. Do they?  (Use TRANSFER to convert the c_ptr to a pointer-sized integer.)

That initializing rdata also changes the behvaior makes me suspicious that there's something you haven't shown at work here.

0 Kudos
Copy link
andrew_4619
Honored Contributor III
‎02-10-2025 03:49 PM
379 Views

I am assuming that if you have f_ptr2 = c_loc(rdata) you have the same value as f_ptr = c_loc(rdata(1,1)) ?

0 Kudos
Copy link
Ben3
Beginner
‎02-10-2025 07:54 PM
327 Views

The code for this particular example is here:

https://github.com/HDFGroup/hdf5/blob/7bf340440909d468dbb3cf41f0ea0d87f5050cea/fortran/test/tH5T_F03.F90#L52-L275

but the same pattern is reproduced elsewhere there. The arrays rdata and wdata are identically declared and allocated at the start of the procedure. And I've confirmed that C_LOC(rdata) is has the same value as C_LOC(rdata(1,1)).

I just noticed that having C_LOC(rdata) anywhere in that subroutine (even right at the end) is enough to make it start work.

Disassembling the non-working case, the call to H5Dread_f is followed by the print - the comparison (and branch) is simply not there.

0 Kudos
Copy link
jimdempseyatthecove
Honored Contributor III
‎02-14-2025 12:02 PM
220 Views

Ben,

I've created and use HDF5 interface functions. You are welcome to use them.

These interface with the current code available from HDFGroup.

 

I assume you already have the HDFGroup libraries etc...

Sorry that I do not have any documentation. However, the following two procedures should be self evident of what you can do:

subroutine INIT_HDF5
    use MOD_HDF5
    implicit none
    ExportFile = HOST%GDBNAM // HOST%GDBNUM // '.h5'
    SnapshotFile = "Snapshot" // ExportFile
    call Open_Output(unitExportFile, ExportFile)
    call HDF5_Create_Info()
    call HDF5_Create_Glossary()
    call HDF5_Create_Units()
    call Create_Group("/Frames")
    NumberOfFrames = 0
    call Write_Attribute("/Frames", "NumberOfFrames", NumberOfFrames)
    !call Close_Output()
    call HDF5_Flush()
    
    call Open_Output(unitSnapshotFile, SnapshotFile)
    call HDF5_Create_Info()
    call HDF5_Create_Glossary()
    call HDF5_Create_Units()
    call Create_Group("/Frames")
    NumberOfSnapshotFrames = 0
    call Write_Attribute("/Frames", "NumberOfFrames", NumberOfSnapshotFrames)
    call HDF5_Flush()
    call Close_Output(unitExportFile)
    
    call HDF5_Append_Frame()
    call HDF5_Append_Snapshot_Frame()
end subroutine INIT_HDF5

And

subroutine HDF5_Append_Tethers(frame)
    use HDF5
    use MOD_HDF5
    use MOD_RPS
    implicit none
    character*(*), intent(in) :: frame
    
    character(1000) :: group, subGroup
    type(TypeTether), pointer :: pTether
    type(TypeFiniteSolution), pointer :: pFiniteSolution
    integer(HSIZE_T) :: dimsXYZextendible(3)
    integer(HSIZE_T) :: maxdimsXYZextendible(3)
    integer(HSIZE_T) :: dimsXextendible(2)
    integer(HSIZE_T) :: maxdimsXextendible(2)
    integer(HSIZE_T) :: dims(3)
    integer(HSIZE_T) :: maxdims(3)
    integer(HID_T) :: dataspace
    integer :: check_error
    integer :: iTether, i
    real(DPkind), allocatable :: Array2D(:,:)
    group = trim(frame) // "/Tethers"
    call Create_Group(group)
  
    do iTether = 1, TOSS%NTETH
        pTether => TOSS%TetherPointer(iTether)%p
        write(group,"('/Tethers/Tether ', I0)"), iTether
        group = trim(frame) // group
        call create_group(trim(group))
        
        ! Insert the common data
        call Write_Attribute(trim(group), "Distance X-End to Y-End", pTether%TDIST * MetersPerFoot)
        call Write_Attribute(trim(group), "dDistance X-End to Y-End", pTether%TDISTD * MetersPerFoot)
        call Write_Attribute(trim(group), "Stretch X-End to Y-End", pTether%STREC * MetersPerFoot)
        call Write_Attribute(trim(group), "dStretch X-End to Y-End", pTether%STRECD * MetersPerFoot)
        call Write_Attribute(trim(group), "X-End Tension", pTether%XELOAD * KilogramsPerSlug * MetersPerFoot * MetersPerFoot)
        call Write_Attribute(trim(group), "Y-End Tension", pTether%YELOAD * KilogramsPerSlug * MetersPerFoot * MetersPerFoot)
        call Write_Attribute(trim(group), "Length", pTether%TLENT * MetersPerFoot)
        if(pTether%LDSIGN /= 0) then
            ! ASSIGN DEPLOYMENT SCENARIO TO TOSS TETHER
            call Write_Attribute(trim(group), "dLength", pTether%TLENTD * MetersPerFoot)
            call Write_Attribute(trim(group), "ddLength", pTether%TLENDD * MetersPerFoot)
            call Write_Attribute(trim(group), "Empty spool mass", pTether%EmptySpoolMass * KilogramsPerSlug)
            call Write_Attribute(trim(group), "Empty spool radius", pTether%EmptySpoolRadius * MetersPerFoot)
            call Write_Attribute(trim(group), "Spool radius", pTether%SpoolRadius * MetersPerFoot)
            call Write_Attribute(trim(group), "Spool angular velocity", pTether%SpoolWindInVector)
            call Write_Attribute(trim(group), "Deployed Mass", pTether%TTMASS * KilogramsPerSlug)
        endif
        if(TOSS%LQEBB > 0) then
            ! INHIBIT/ACTIVATE PLANET BLACK BODY RADIATION HEATING
            call Write_Attribute(trim(group), "Planet black body radiation temperature", pTether%PLNTMP)
        endif
        if(TOSS%LQSOLR > 0) then
            ! INHIBIT/ACTIVATE DIRECT SOLAR RADIATION HEATING
            call Write_Attribute(trim(group), "Solar Vector towards planet", pTether%SOLVEC)
        endif
        call Write_Attribute(trim(group), "Voltage", pTether%VOLTF)
        call Write_Attribute(trim(group), "AE/L coefficient", pTether%TTAEOL)
        call Write_Attribute(trim(group), "End-to-End Damping coefficient", pTether%TTCDMP)
        call Write_Attribute(trim(group), "Total undeformed length", pTether%TotalUndeformedTetherLength * MetersPerFoot)
        call Write_Attribute(trim(group), "Total tether mass", pTether%TotalTetherMass * KilogramsPerSlug)
        call Write_Attribute(trim(group), "X-End Object", pTether%NOBJX)
        call Write_Attribute(trim(group), "X-End Attach Point", pTether%LATTX)
        call Write_Attribute(trim(group), "Y-End Object", pTether%NOBJY)
        call Write_Attribute(trim(group), "Y-End Attach Point", pTether%LATTY)
        
        if(pTether%LASIGN == 0) then
            call Write_Attribute(trim(group), "Type", "Massless")
            ! lbf/ft -> N/m
            ! N/m = (lbf / lbfPerNewton) / (ft * MetersPerFoot)
            call Write_Attribute(trim(group), "Spring Rate", (pTether%TTSPGO / lbfPerNewton) / MetersPerFoot)
            ! lbf/(ft/s) -> N/(m/s)
            call Write_Attribute(trim(group), "Spring Damping", (pTether%TTDMPO / lbfPerNewton) / MetersPerFoot)
            ! lbf/ft -> N/m
            call Write_Attribute(trim(group), "Spring Stiffness", (pTether%TTAE / lbfPerNewton) / MetersPerFoot)
            cycle
        endif
        
        call Write_Attribute(trim(group), "FiniteSolution", pTether%LASIGN)
        
        pFiniteSolution => pTether%pFiniteSolution
        call Write_Attribute(trim(group), "nType", pFiniteSolution%NFTYP)
        
        IF(pFiniteSolution%NNUPR == 0) then
            call Write_Attribute(trim(group), "Type", "Uniform")
            ! Uniform tethers have 1 region
        else
            call Write_Attribute(trim(group), "Type", "Non-Uniform")
        endif
        ! scalars and small arrays
        call Write_Attribute(trim(group), "Angular Velocity Vector TF", pFiniteSolution%OMT)
        call Write_Attribute(trim(group), "X-End Deployment moment mass transfer force", pFiniteSolution%XEFMT * KilogramsPerSlug * MetersPerFoot * MetersPerFoot)
        call Write_Attribute(trim(group), "Y-End Deployment moment mass transfer force", pFiniteSolution%YEFMT * KilogramsPerSlug * MetersPerFoot * MetersPerFoot)
        call Write_Attribute(trim(group), "Arc Length of tether", pFiniteSolution%ARCTOT * MetersPerFoot)
        call Write_Attribute(trim(group), "Speed of sound in tether", pFiniteSolution%SpeedOfSoundFPS * MetersPerFoot)
        call Write_Attribute(trim(group), "Deployed undeformed length with thermal expansion", pFiniteSolution%SEGLAT * MetersPerFoot)
        call Write_Attribute(trim(group), "Total Bead Mass", pFiniteSolution%BMSTOT * KilogramsPerSlug)
        call Write_Attribute(trim(group), "Number of beads", pFiniteSolution%NBEAD)
        ! Bead information
        subGroup = trim(group) // '/Beads'
        call Create_Group(trim(subGroup))

        Array2D = pFiniteSolution%BeadIPIF
        do i=lbound(Array2D, dim=2), ubound(Array2D, dim=2)
            Array2D(:,i) =  Array2D(:,i) * MetersPerFoot
        end do
        call Write_DataSet(trim(subGroup), "Positions", Array2D)
            
        Array2D = pFiniteSolution%BeadDIPIF
        do i=lbound(Array2D, dim=2), ubound(Array2D, dim=2)
            Array2D(:,i) =  Array2D(:,i) * MetersPerFoot
        end do
        call Write_DataSet(trim(subGroup), "Velocities", Array2D)
        call Write_DataSet(trim(subGroup), "Accelerations", pFiniteSolution%BeadDDIPIF * MetersPerFoot)
        call Write_DataSet(trim(subGroup), "External Forces", pFiniteSolution%BeadFEXIF * KilogramsPerSlug * MetersPerFoot * MetersPerFoot)
        call Write_DataSet(trim(subGroup), "Spring+Damping Forces", pFiniteSolution%BeadFSIF * KilogramsPerSlug * MetersPerFoot * MetersPerFoot)
        call Write_DataSet(trim(subGroup), "Low coord sensitivity Forces", pFiniteSolution%BeadCINSIF * KilogramsPerSlug * MetersPerFoot * MetersPerFoot)
        call Write_DataSet(trim(subGroup), "Acceleration of gravity", pFiniteSolution%BeadAGIF * MetersPerFoot)
        call Write_DataSet(trim(subGroup), "Bead Mass", pFiniteSolution%BMS * KilogramsPerSlug)
        call Write_DataSet(trim(subGroup), "Bead Displacement", pFiniteSolution%Displacement / CubicFeetPerCubicMeter)
        ! segment information
        subGroup = trim(group) // '/Segments'
        call Create_Group(trim(subGroup))
        call Write_DataSet(trim(subGroup), "Tensions", pFiniteSolution%TENSEG * KilogramsPerSlug * MetersPerFoot * MetersPerFoot)
        call Write_DataSet(trim(subGroup), "Spring Rate", pFiniteSolution%BEADKS * KilogramsPerSlug * MetersPerFoot * MetersPerFoot * MetersPerFoot)
        call Write_DataSet(trim(subGroup), "Spring Damping coefficient", pFiniteSolution%BEADKD)
        call Write_DataSet(trim(subGroup), "Segment Length", pFiniteSolution%SEGLA * MetersPerFoot)
        call Write_DataSet(trim(subGroup), "Segment Length (without thermal)", pFiniteSolution%SEGLAunExpanded * MetersPerFoot)
        call Write_DataSet(trim(subGroup), "Segment Length (strained)", pFiniteSolution%ELBSG * MetersPerFoot)
        call Write_DataSet(trim(subGroup), "Undeformed elastic area", pFiniteSolution%BEADELA * MetersPerFoot * MetersPerFoot)
        call Write_DataSet(trim(subGroup), "Strains", (pFiniteSolution%ELBSG - pFiniteSolution%SEGLA) / pFiniteSolution%SEGLA)
        call Write_DataSet(trim(subGroup), "External force", pFiniteSolution%SegFEXIF * KilogramsPerSlug * MetersPerFoot * MetersPerFoot)
                
#if 0  
! this can be calculated
        call Write_DataSet(trim(subGroup), "MU Derivitive", pFiniteSolution%DSDU)
        call Write_DataSet(trim(subGroup), "dMU Derivitive", pFiniteSolution%DSDUD)
#endif        
        if(pTether%LESIGN /= 0) then
            call Write_DataSet(trim(subGroup), "Segment current", pFiniteSolution%CURRTS)
            if(TOSS%LOPE > 0) then
                ! TETHER-GLOBAL ELECTROMAGNETIC FORCE CALC OPTION SPECIFIER
                ! .and.
                ! ASSIGN ELECTRIC POWER GENERATION SCENARIO TO TOSS TETHER
                call Write_DataSet(trim(subGroup), "Magnetic field BFL", pFiniteSolution%BFLSEG)
                call Write_DataSet(trim(subGroup), "Magnetic field BVL", pFiniteSolution%BVLSEG)
            endif
        endif
        
        if(TOSS%LEXPND > 0) then
            ! INHIBIT/ACTIVATE THERMAL EXPANSION CHANGES IN TETHER LENGTH
            call Write_DataSet(trim(subGroup), "Segment Length (with thermal)", pFiniteSolution%SEGLA * MetersPerFoot)
        endif
        
        if(TOSS%LQOHMS > 0) then
            ! INHIBIT/ACTIVATE ELECTRICAL RESISTIVE HEATING
            call Write_DataSet(trim(subGroup), "Temp comp resistance per length", pFiniteSolution%RHOELT / MetersPerFoot)
        endif
        
        if(TOSS%LQTRAD > 0) then
            ! INHIBIT/ACTIVATE HEAT RADIATION FROM TETHER
        endif
        if(TOSS%LQCOND > 0) then
            ! INHIBIT/ACTIVATE LONGITUDINAL HEAT CONDUCTION ALONG TETHER
        endif
        if(TOSS%LOPA > 0) then
            ! TETHER-GLOBAL AERODYNAMIC FORCE CALC OPTION SPECIFIER
            call Write_DataSet(trim(subGroup), "Aero diameter", (pFiniteSolution%DIARO / 12.0_8) * MetersPerFoot)
            call Write_DataSet(trim(subGroup), "Atmospheric winds", pFiniteSolution%WNDTOE * MetersPerFoot)
            call Write_DataSet(trim(subGroup), "Relative wind", pFiniteSolution%VRELSGI * MetersPerFoot)
            call Write_DataSet(trim(subGroup), "Aero load", pFiniteSolution%FAROSGI * KilogramsPerSlug * MetersPerFoot * MetersPerFoot)
            call Write_DataSet(trim(subGroup), "Local wind pertubation", pFiniteSolution%WNDLPE * MetersPerFoot)
        endif
        if(TOSS%LDOTEF > 0) then
            ! IC OPTION TO ACTIVATE/INHIBIT TETHER DEPLOY MASS FLOW EFFECTS
        endif
        if(TheRPS%LEVPLS .EQ. 1) then
            call Write_DataSet(trim(subGroup), "Temp comp plasma circumference", pFiniteSolution%EDYNCT * MetersPerFoot)
            call Write_DataSet(trim(subGroup), "Electron density", pFiniteSolution%EDENSBB / CubicFeetPerCubicMeter)
        endif
        
    end do
end subroutine HDF5_Append_Tethers

Jim Dempsey

MOD_HDF5.f90
45 KB
0 Kudos
Copy link
Reply

Community support is provided Monday to Friday. Other contact methods are available here.

Intel does not verify all solutions, including but not limited to any file transfers that may appear in this community. Accordingly, Intel disclaims all express and implied warranties, including without limitation, the implied warranties of merchantability, fitness for a particular purpose, and non-infringement, as well as any warranty arising from course of performance, course of dealing, or usage in trade.

For more complete information about compiler optimizations, see our Optimization Notice.