crp/OpenMC
1
0
Fork 0
mirror of https://github.com/openmc-dev/openmc.git synced 2026-07-28 22:26:08 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 5

Support for ifort with polymorphic lattices

Browse source 
Intel Fortran raises a compilation error when a pointer to a polymorphic object is passed from inside a 'type is' block to a dummy argument which is a pointer to the object's parent class.
This commit is contained in:
Sterling Harper 2014-08-13 19:18:31 +02:00
parent ca4b00e053
commit 56d433266a
2 changed files with 15 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/geometry.F90
View file

@ -280,9 +280,9 @@ contains
!===============================================================================
function get_lat_trans(lat, xyz, i_xyz) result(xyz_t)
class(Lattice), pointer, intent(in) :: lat
real(8) , intent(in) :: xyz(3)
integer , intent(in) :: i_xyz(3)
class(Lattice), intent(in) :: lat
real(8) , intent(in) :: xyz(3)
integer , intent(in) :: i_xyz(3)
real(8) :: xyz_t(3)
@ -327,9 +327,9 @@ contains
!===============================================================================
function is_valid_lat_index(lat, i_xyz) result(is_valid)
class(Lattice), pointer, intent(in) :: lat
integer , intent(in) :: i_xyz(3)
logical :: is_valid
class(Lattice), intent(in) :: lat
integer , intent(in) :: i_xyz(3)
logical :: is_valid
integer :: n_rings, n_x, n_y, n_z
@ -373,9 +373,9 @@ contains
!===============================================================================
function get_lat_indices(lat, xyz, uvw) result(i_xyz)
class(Lattice), pointer, intent(in) :: lat
real(8) , intent(in) :: xyz(3)
real(8) , intent(in) :: uvw(3)
class(Lattice), intent(in) :: lat
real(8) , intent(in) :: xyz(3)
real(8) , intent(in) :: uvw(3)
integer :: i_xyz(3)

11
src/hdf5_summary.F90
View file

@ -5,7 +5,8 @@ module hdf5_summary
use ace_header, only: Reaction, UrrData, Nuclide
use constants
use endf, only: reaction_name
use geometry_header, only: Cell, Surface, Universe, Lattice
use geometry_header, only: Cell, Surface, Universe, Lattice, RectLattice, &
&HexLattice
use global
use material_header, only: Material
use mesh_header, only: StructuredMesh
@ -148,7 +149,7 @@ contains
case (CELL_LATTICE)
call su % write_data("lattice", "fill_type", &
group="geometry/cells/cell " // trim(to_str(c % id)))
call su % write_data(lattices(c % fill) % id, "lattice", &
call su % write_data(lattices(c % fill) % obj % id, "lattice", &
group="geometry/cells/cell " // trim(to_str(c % id)))
end select
@ -272,14 +273,14 @@ contains
! Write information on each lattice
LATTICE_LOOP: do i = 1, n_lattices
lat => lattices(i)
lat => lattices(i) % obj
! Write lattice type
select type (lat)
type is (LatticeRect)
type is (RectLattice)
call su % write_data("rectangular", "type", &
group="geometry/lattices/lattice " // trim(to_str(lat % id)))
type is (LatticeHex)
type is (HexLattice)
call su % write_data("hexagonal", "type", &
group="geometry/lattices/lattice " // trim(to_str(lat % id)))
end select