From 9f018678adaf86dcc2df4050f66f2380a75b827e Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 14 Apr 2015 15:47:36 -0500 Subject: [PATCH 1/7] Remove threadprivate declaration, save attribute, and null initialization for pointers in routines that are called by multiple threads. The null initialization made the duration of these variables static, thus necessitating that they be declared threadprivate and have the save attribute. --- src/cross_section.F90 | 16 +++++-------- src/geometry.F90 | 54 +++++++++++++++++++------------------------ src/physics.F90 | 31 +++++++++---------------- src/source.F90 | 3 +-- src/tally.F90 | 42 +++++++++++++++------------------ src/tracking.F90 | 3 +-- 6 files changed, 61 insertions(+), 88 deletions(-) diff --git a/src/cross_section.F90 b/src/cross_section.F90 index 1672405e8..10ea81d94 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -32,8 +32,7 @@ contains integer :: j ! index in mat % i_sab_nuclides real(8) :: atom_density ! atom density of a nuclide logical :: check_sab ! should we check for S(a,b) table? - type(Material), pointer, save :: mat => null() ! current material -!$omp threadprivate(mat) + type(Material), pointer :: mat ! current material ! Set all material macroscopic cross sections to zero material_xs % total = ZERO @@ -141,8 +140,7 @@ contains integer :: i_low, i_high ! bounding indices from logarithmic mapping integer :: u ! index into logarithmic mapping array real(8) :: f ! interp factor on nuclide energy grid - type(Nuclide), pointer, save :: nuc => null() -!$omp threadprivate(nuc) + type(Nuclide), pointer :: nuc ! Set pointer to nuclide nuc => nuclides(i_nuclide) @@ -271,8 +269,7 @@ contains real(8) :: f ! interp factor on S(a,b) energy grid real(8) :: inelastic ! S(a,b) inelastic cross section real(8) :: elastic ! S(a,b) elastic cross section - type(SAlphaBeta), pointer, save :: sab => null() -!$omp threadprivate(sab) + type(SAlphaBeta), pointer :: sab ! Set flag that S(a,b) treatment should be used for scattering micro_xs(i_nuclide) % index_sab = i_sab @@ -364,10 +361,9 @@ contains real(8) :: fission ! fission cross section real(8) :: inelastic ! inelastic cross section logical :: same_nuc ! do we know the xs for this nuclide at this energy? - type(UrrData), pointer, save :: urr => null() - type(Nuclide), pointer, save :: nuc => null() - type(Reaction), pointer, save :: rxn => null() -!$omp threadprivate(urr, nuc, rxn) + type(UrrData), pointer :: urr + type(Nuclide), pointer :: nuc + type(Reaction), pointer :: rxn micro_xs(i_nuclide) % use_ptable = .true. diff --git a/src/geometry.F90 b/src/geometry.F90 index 3857e03f9..565d793c9 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -30,8 +30,7 @@ contains integer :: i_surface ! index in surfaces array (with sign) logical :: specified_sense ! specified sense of surface in list logical :: actual_sense ! sense of particle wrt surface - type(Surface), pointer, save :: s => null() -!$omp threadprivate(s) + type(Surface), pointer :: s SURFACE_LOOP: do i = 1, c % n_surfaces ! Lookup surface @@ -79,10 +78,9 @@ contains integer :: i ! cell loop index on a level integer :: n ! number of cells to search on a level integer :: index_cell ! index in cells array - type(Cell), pointer, save :: c => null() ! pointer to cell - type(Universe), pointer, save :: univ => null() ! universe to search in - type(LocalCoord), pointer, save :: coord => null() ! particle coordinate to search on -!$omp threadprivate(c, univ, coord) + type(Cell), pointer :: c ! pointer to cell + type(Universe), pointer :: univ ! universe to search in + type(LocalCoord), pointer :: coord ! particle coordinate to search on coord => p % coord0 @@ -132,15 +130,14 @@ contains logical, intent(inout) :: found integer, optional :: search_cells(:) - integer :: i ! index over cells - integer :: i_xyz(3) ! indices in lattice - integer :: n ! number of cells to search - integer :: index_cell ! index in cells array - logical :: use_search_cells ! use cells provided as argument - type(Cell), pointer, save :: c => null() ! pointer to cell - class(Lattice), pointer, save :: lat => null() ! pointer to lattice - type(Universe), pointer, save :: univ => null() ! universe to search in -!$omp threadprivate(c, lat, univ) + integer :: i ! index over cells + integer :: i_xyz(3) ! indices in lattice + integer :: n ! number of cells to search + integer :: index_cell ! index in cells array + logical :: use_search_cells ! use cells provided as argument + type(Cell), pointer :: c ! pointer to cell + class(Lattice), pointer :: lat ! pointer to lattice + type(Universe), pointer :: univ ! universe to search in ! Remove coordinates for any lower levels call deallocate_coord(p % coord % next) @@ -294,8 +291,7 @@ contains real(8) :: norm ! "norm" of surface normal integer :: i_surface ! index in surfaces logical :: found ! particle found in universe? - type(Surface), pointer, save :: surf => null() -!$omp threadprivate(surf) + type(Surface), pointer :: surf i_surface = abs(p % surface) surf => surfaces(i_surface) @@ -575,9 +571,8 @@ contains integer :: i_xyz(3) ! indices in lattice logical :: found ! particle found in cell? - class(Lattice), pointer, save :: lat => null() - type(LocalCoord), pointer, save :: parent_coord => null() -!$omp threadprivate(lat, parent_coord) + class(Lattice), pointer :: lat + type(LocalCoord), pointer :: parent_coord lat => lattices(p % coord % lattice) % obj @@ -598,9 +593,9 @@ contains p % coord % lattice_x = p % coord % lattice_x + lattice_translation(1) p % coord % lattice_y = p % coord % lattice_y + lattice_translation(2) p % coord % lattice_z = p % coord % lattice_z + lattice_translation(3) - i_xyz(1) = p % coord % lattice_x - i_xyz(2) = p % coord % lattice_y - i_xyz(3) = p % coord % lattice_z + i_xyz(1) = p % coord % lattice_x + i_xyz(2) = p % coord % lattice_y + i_xyz(3) = p % coord % lattice_z ! Set the new coordinate position. p % coord % xyz = lat % get_local_xyz(parent_coord % xyz, i_xyz) @@ -676,13 +671,12 @@ contains real(8) :: a,b,c,k ! quadratic equation coefficients real(8) :: quad ! discriminant of quadratic equation logical :: on_surface ! is particle on surface? - type(Cell), pointer, save :: cl => null() - type(Surface), pointer, save :: surf => null() - class(Lattice), pointer, save :: lat => null() - type(LocalCoord), pointer, save :: coord => null() - type(LocalCoord), pointer, save :: final_coord => null() - type(LocalCoord), pointer, save :: parent_coord => null() -!$omp threadprivate(cl, surf, lat, coord, final_coord, parent_coord) + type(Cell), pointer :: cl + type(Surface), pointer :: surf + class(Lattice), pointer :: lat + type(LocalCoord), pointer :: coord + type(LocalCoord), pointer :: final_coord + type(LocalCoord), pointer :: parent_coord ! inialize distance to infinity (huge) dist = INFINITY diff --git a/src/physics.F90 b/src/physics.F90 index 69bbcff34..0b276c9fc 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -74,8 +74,7 @@ contains integer :: i_nuclide ! index in nuclides array integer :: i_reaction ! index in nuc % reactions array - type(Nuclide), pointer, save :: nuc => null() -!$omp threadprivate(nuc) + type(Nuclide), pointer :: nuc i_nuclide = sample_nuclide(p, 'total ') @@ -133,8 +132,7 @@ contains real(8) :: cutoff real(8) :: atom_density ! atom density of nuclide in atom/b-cm real(8) :: sigma ! microscopic total xs for nuclide - type(Material), pointer, save :: mat => null() -!$omp threadprivate(mat) + type(Material), pointer :: mat ! Get pointer to current material mat => materials(p % material) @@ -195,9 +193,8 @@ contains real(8) :: f real(8) :: prob real(8) :: cutoff - type(Nuclide), pointer, save :: nuc => null() - type(Reaction), pointer, save :: rxn => null() -!$omp threadprivate(nuc, rxn) + type(Nuclide), pointer :: nuc + type(Reaction), pointer :: rxn ! Get pointer to nuclide nuc => nuclides(i_nuclide) @@ -313,9 +310,8 @@ contains real(8) :: f real(8) :: prob real(8) :: cutoff - type(Nuclide), pointer, save :: nuc => null() - type(Reaction), pointer, save :: rxn => null() -!$omp threadprivate(nuc, rxn) + type(Nuclide), pointer :: nuc + type(Reaction), pointer :: rxn ! Get pointer to nuclide and grid index/interpolation factor nuc => nuclides(i_nuclide) @@ -418,8 +414,7 @@ contains real(8) :: v_cm(3) ! velocity of center-of-mass real(8) :: v_t(3) ! velocity of target nucleus real(8) :: uvw_cm(3) ! directional cosines in center-of-mass - type(Nuclide), pointer, save :: nuc => null() -!$omp threadprivate(nuc) + type(Nuclide), pointer :: nuc ! get pointer to nuclide nuc => nuclides(i_nuclide) @@ -497,7 +492,7 @@ contains real(8) :: mu_ijk ! outgoing cosine k for E_in(i) and E_out(j) real(8) :: mu_i1jk ! outgoing cosine k for E_in(i+1) and E_out(j) real(8) :: prob ! probability for sampling Bragg edge - type(SAlphaBeta), pointer, save :: sab => null() + type(SAlphaBeta), pointer :: sab ! Following are needed only for SAB_SECONDARY_CONT scattering integer :: l ! sampled incoming E bin (is i or i + 1) real(8) :: E_i_1, E_i_J ! endpoints on outgoing grid i @@ -509,8 +504,6 @@ contains real(8) :: frac ! interpolation factor on outgoing energy real(8) :: r1 ! RNG for outgoing energy -!$omp threadprivate(sab) - ! Get pointer to S(a,b) table sab => sab_tables(i_sab) @@ -1067,9 +1060,8 @@ contains real(8) :: phi ! fission neutron azimuthal angle real(8) :: weight ! weight adjustment for ufs method logical :: in_mesh ! source site in ufs mesh? - type(Nuclide), pointer, save :: nuc => null() - type(Reaction), pointer, save :: rxn => null() -!$omp threadprivate(nuc, rxn) + type(Nuclide), pointer :: nuc + type(Reaction), pointer :: rxn ! Get pointers nuc => nuclides(i_nuclide) @@ -1175,8 +1167,7 @@ contains real(8) :: xi ! random number real(8) :: yield ! delayed neutron precursor yield real(8) :: prob ! cumulative probability - type(DistEnergy), pointer, save :: edist => null() -!$omp threadprivate(edist) + type(DistEnergy), pointer :: edist ! Determine total nu nu_t = nu_total(nuc, E) diff --git a/src/source.F90 b/src/source.F90 index 3a12a3f71..4f931dc90 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -256,8 +256,7 @@ contains integer(8) :: particle_seed ! unique index for particle integer :: i - type(Bank), pointer, save :: src => null() -!$omp threadprivate(src) + type(Bank), pointer :: src ! set defaults call p % initialize() diff --git a/src/tally.F90 b/src/tally.F90 index 39067a9c0..902811480 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -55,8 +55,7 @@ contains real(8) :: macro_total ! material macro total xs real(8) :: macro_scatt ! material macro scatt xs logical :: found_bin ! scoring bin found? - type(TallyObject), pointer, save :: t => null() -!$omp threadprivate(t) + type(TallyObject), pointer :: t ! Copy particle's pre- and post-collision weight and angle last_wgt = p % last_wgt @@ -656,10 +655,9 @@ contains real(8) :: score ! actual score (e.g., flux*xs) real(8) :: atom_density ! atom density of single nuclide in atom/b-cm logical :: found_bin ! scoring bin found? - type(TallyObject), pointer, save :: t => null() - type(Material), pointer, save :: mat => null() - type(Reaction), pointer, save :: rxn => null() -!$omp threadprivate(t, mat, rxn) + type(TallyObject), pointer :: t + type(Material), pointer :: mat + type(Reaction), pointer :: rxn ! Determine track-length estimate of flux flux = p % wgt * distance @@ -1062,10 +1060,9 @@ contains real(8) :: f ! interpolation factor real(8) :: score ! actual scoring tally value real(8) :: atom_density ! atom density of single nuclide in atom/b-cm - type(TallyObject), pointer, save :: t => null() - type(Material), pointer, save :: mat => null() - type(Reaction), pointer, save :: rxn => null() -!$omp threadprivate(t, mat, rxn) + type(TallyObject), pointer :: t + type(Material), pointer :: mat + type(Reaction), pointer :: rxn ! Get pointer to tally t => tallies(i_tally) @@ -1411,11 +1408,10 @@ contains logical :: found_bin ! was a scoring bin found? logical :: start_in_mesh ! starting coordinates inside mesh? logical :: end_in_mesh ! ending coordinates inside mesh? - type(TallyObject), pointer, save :: t => null() - type(StructuredMesh), pointer, save :: m => null() - type(Material), pointer, save :: mat => null() - type(LocalCoord), pointer, save :: coord => null() -!$omp threadprivate(t, m, mat, coord) + type(TallyObject), pointer :: t + type(StructuredMesh), pointer :: m + type(Material), pointer :: mat + type(LocalCoord), pointer :: coord t => tallies(i_tally) matching_bins(1:t%n_filters) = 1 @@ -1814,10 +1810,9 @@ contains integer :: i ! loop index for filters integer :: n ! number of bins for single filter real(8) :: E ! particle energy - type(TallyObject), pointer, save :: t => null() - type(StructuredMesh), pointer, save :: m => null() - type(LocalCoord), pointer, save :: coord => null() -!$omp threadprivate(t, m, coord) + type(TallyObject), pointer :: t + type(StructuredMesh), pointer :: m + type(LocalCoord), pointer :: coord found_bin = .true. t => tallies(i_tally) @@ -1945,9 +1940,8 @@ contains logical :: x_same ! same starting/ending x index (i) logical :: y_same ! same starting/ending y index (j) logical :: z_same ! same starting/ending z index (k) - type(TallyObject), pointer, save :: t => null() - type(StructuredMesh), pointer, save :: m => null() -!$omp threadprivate(t, m) + type(TallyObject), pointer :: t + type(StructuredMesh), pointer :: m TALLY_LOOP: do i = 1, active_current_tallies % size() ! Copy starting and ending location of particle @@ -2346,7 +2340,7 @@ contains real(8), allocatable :: tally_temp(:,:) ! contiguous array of results real(8) :: global_temp(N_GLOBAL_TALLIES) real(8) :: dummy ! temporary receive buffer for non-root reduces - type(TallyObject), pointer :: t => null() + type(TallyObject), pointer :: t do i = 1, active_tallies % size() t => tallies(active_tallies % get_item(i)) @@ -2440,7 +2434,7 @@ contains subroutine tally_statistics() integer :: i ! index in tallies array - type(TallyObject), pointer :: t => null() + type(TallyObject), pointer :: t ! Calculate statistics for user-defined tallies do i = 1, n_tallies diff --git a/src/tracking.F90 b/src/tracking.F90 index c939f7991..8459db66d 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -36,8 +36,7 @@ contains real(8) :: d_collision ! sampled distance to collision real(8) :: distance ! distance particle travels logical :: found_cell ! found cell which particle is in? - type(LocalCoord), pointer, save :: coord => null() -!$omp threadprivate(coord) + type(LocalCoord), pointer :: coord ! Display message if high verbosity or trace is on if (verbosity >= 9 .or. trace) then From d1767ad6e8d834e3bc5fef5fb7ff14457d1d5a8f Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 16 Apr 2015 08:41:45 -0500 Subject: [PATCH 2/7] Slightly simplify sorted list of energies for union grid construction --- src/energy_grid.F90 | 21 +++++---------------- 1 file changed, 5 insertions(+), 16 deletions(-) diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index 86a34f732..9bde48a5e 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -26,7 +26,7 @@ contains integer :: i ! index in nuclides array integer :: j ! index in materials array - type(ListReal), pointer :: list + type(ListReal) :: list type(Nuclide), pointer :: nuc type(Material), pointer :: mat @@ -51,7 +51,6 @@ contains ! delete linked list and dictionary call list % clear() - deallocate(list) end do ! Set pointers to unionized energy grid for each nuclide @@ -71,7 +70,7 @@ contains real(8) :: E_max ! Maximum energy in MeV real(8) :: E_min ! Minimum energy in MeV real(8), allocatable :: umesh(:) ! Equally log-spaced energy grid - type(Nuclide), pointer :: nuc => null() + type(Nuclide), pointer :: nuc ! Set minimum/maximum energies E_max = 20.0_8 @@ -115,7 +114,7 @@ contains subroutine add_grid_points(list, energy) - type(ListReal), pointer :: list + type(ListReal) :: list real(8), intent(in) :: energy(:) integer :: i ! index in energy array @@ -126,16 +125,6 @@ contains i = 1 n = size(energy) - ! If the original list is empty, we need to allocate the first element and - ! store first energy point - if (.not. associated(list)) then - allocate(list) - do i = 1, n - call list % append(energy(i)) - end do - return - end if - ! Set current index to beginning of the list current = 1 @@ -188,8 +177,8 @@ contains integer :: index_e ! index on union energy grid real(8) :: union_energy ! energy on union grid real(8) :: energy ! energy on nuclide grid - type(Nuclide), pointer :: nuc => null() - type(Material), pointer :: mat => null() + type(Nuclide), pointer :: nuc + type(Material), pointer :: mat do k = 1, n_materials mat => materials(k) From d3bd32740625a1b9fadb1e28f404f13982005ff6 Mon Sep 17 00:00:00 2001 From: "Sterling M. Harper" Date: Fri, 24 Apr 2015 18:31:33 -0400 Subject: [PATCH 3/7] Allow strings in material.add_nuclide in py API --- src/utils/openmc/material.py | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/utils/openmc/material.py b/src/utils/openmc/material.py index d3baf3912..87255083b 100644 --- a/src/utils/openmc/material.py +++ b/src/utils/openmc/material.py @@ -189,23 +189,27 @@ class Material(object): def add_nuclide(self, nuclide, percent, percent_type='ao'): - if not isinstance(nuclide, openmc.Nuclide): - msg = 'Unable to add an Nuclide to Material ID={0} with a ' \ + if not isinstance(nuclide, (openmc.Nuclide, str)): + msg = 'Unable to add a Nuclide to Material ID={0} with a ' \ 'non-Nuclide value {1}'.format(self._id, nuclide) raise ValueError(msg) elif not is_float(percent): - msg = 'Unable to add an Nuclide to Material ID={0} with a ' \ + msg = 'Unable to add a Nuclide to Material ID={0} with a ' \ 'non-floating point value {1}'.format(self._id, percent) raise ValueError(msg) elif not percent_type in ['ao', 'wo', 'at/g-cm']: - msg = 'Unable to add an Nuclide to Material ID={0} with a ' \ + msg = 'Unable to add a Nuclide to Material ID={0} with a ' \ 'percent type {1}'.format(self._id, percent_type) raise ValueError(msg) - # Copy this Nuclide to separate it from the Nuclide in other Materials - nuclide = deepcopy(nuclide) + if isinstance(nuclide, openmc.Nuclide): + # Copy this Nuclide to separate it from the Nuclide in + # other Materials + nuclide = deepcopy(nuclide) + else: + nuclide = openmc.Nuclide(nuclide) self._nuclides[nuclide._name] = (nuclide, percent, percent_type) From 8802ccf18e40a09c35da45cc8b28e60bf53d31e4 Mon Sep 17 00:00:00 2001 From: "Sterling M. Harper" Date: Fri, 24 Apr 2015 19:13:22 -0400 Subject: [PATCH 4/7] Fixed void material for Python API --- src/utils/openmc/universe.py | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/utils/openmc/universe.py b/src/utils/openmc/universe.py index e3280b3e3..419d3bd10 100644 --- a/src/utils/openmc/universe.py +++ b/src/utils/openmc/universe.py @@ -345,6 +345,9 @@ class Cell(object): element.set("fill", str(self._fill._id)) self._fill.create_xml_subelement(xml_element) + elif self._fill == "void": + element.set("material", "void") + else: element.set("fill", str(self._fill)) self._fill.create_xml_subelement(xml_element) From 5bbe4903452f149f071934adc411b94d1fe8fc13 Mon Sep 17 00:00:00 2001 From: "Sterling M. Harper" Date: Fri, 24 Apr 2015 19:46:36 -0400 Subject: [PATCH 5/7] Made Python API more robust for void material --- src/utils/openmc/universe.py | 33 ++++++++++++++++++++------------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/src/utils/openmc/universe.py b/src/utils/openmc/universe.py index 419d3bd10..ab663269d 100644 --- a/src/utils/openmc/universe.py +++ b/src/utils/openmc/universe.py @@ -114,23 +114,30 @@ class Cell(object): @fill.setter def fill(self, fill): - if not isinstance(fill, (openmc.Material, Universe, Lattice)) \ - and fill != 'void': + if isinstance(fill, str): + if fill.strip().lower() == 'void': + self._type = 'void' + else: + msg = 'Unable to set Cell ID={0} to use a non-Material or ' \ + 'Universe fill {1}'.format(self._id, fill) + raise ValueError(msg) + + elif isinstance(fill, openmc.Material): + self._type = 'normal' + + elif isinstance(fill, Universe): + self._type = 'fill' + + elif isinstance(fill, Lattice): + self._type = 'lattice' + + else: msg = 'Unable to set Cell ID={0} to use a non-Material or ' \ 'Universe fill {1}'.format(self._id, fill) raise ValueError(msg) self._fill = fill - if isinstance(fill, Lattice): - self._type = 'lattice' - elif isinstance(fill, Universe): - self._type = 'fill' - elif fill == 'void': - self._type = 'normal' - else: - self._type = 'normal' - @rotation.setter def rotation(self, rotation): @@ -247,7 +254,7 @@ class Cell(object): path = path[1:] # If the Cell is filled by a Material - if self._type == 'normal': + if self._type == 'normal' or self._type == 'void': offset = 0 # If the Cell is filled by a Universe @@ -345,7 +352,7 @@ class Cell(object): element.set("fill", str(self._fill._id)) self._fill.create_xml_subelement(xml_element) - elif self._fill == "void": + elif self._fill.strip().lower() == "void": element.set("material", "void") else: From cd67d8f526c1365da2de2d33530172f88cde69e4 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 26 Apr 2015 14:29:57 +0700 Subject: [PATCH 6/7] Fix error in property setter for num_flushes --- src/utils/openmc/cmfd.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/utils/openmc/cmfd.py b/src/utils/openmc/cmfd.py index 6e7eb162a..8e2222215 100644 --- a/src/utils/openmc/cmfd.py +++ b/src/utils/openmc/cmfd.py @@ -514,8 +514,8 @@ class CMFDFile(object): self._norm = norm - @snes_monitor.setter - def snum_flushes(self, num_flushes): + @num_flushes.setter + def num_flushes(self, num_flushes): if not is_integer(num_flushes): msg = 'Unable to set the CMFD number of flushes to {0} ' \ From fa820b060d261fcef589e332e003312fb818a687 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 26 Apr 2015 10:03:53 +0000 Subject: [PATCH 7/7] Two small fixes for IBM XL Fortran compiler --- src/CMakeLists.txt | 3 ++- src/string.F90 | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 89a4a60e1..d3785aa6a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -116,7 +116,8 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "PGI") elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "XL") # IBM XL compiler options - set(f90flags "-WF,-DNO_F2008 -O2") + set(f90flags "-O2") + add_definitions(-DNO_F2008) if(debug) set(f90flags "-g -C -qflag=i:i -u") set(ldflags "-g") diff --git a/src/string.F90 b/src/string.F90 index 5071493f8..ebe2310f2 100644 --- a/src/string.F90 +++ b/src/string.F90 @@ -151,7 +151,7 @@ contains ! TO_LOWER converts a string to all lower case characters !=============================================================================== - elemental function to_lower(word) result(word_lower) + function to_lower(word) result(word_lower) character(*), intent(in) :: word character(len=len(word)) :: word_lower @@ -174,7 +174,7 @@ contains ! TO_UPPER converts a string to all upper case characters !=============================================================================== - elemental function to_upper(word) result(word_upper) + function to_upper(word) result(word_upper) character(*), intent(in) :: word character(len=len(word)) :: word_upper