Commit 2ac50633 authored by Jorn Bruggeman's avatar Jorn Bruggeman
Browse files

simplified unpacking

parent d81713ca
......@@ -480,66 +480,41 @@
#endif
#ifdef _HAS_MASK_
! Using pack/unpack intrinsics
!# define _PACK_GLOBAL_(in, out, i, env) out(:, i) = pack(in _INDEX_GLOBAL_INTERIOR_(_START_:_STOP_), env%mask)
!# define _PACK_GLOBAL_PLUS_1_(in, i, out, j, env) out(:, j) = pack(in _INDEX_GLOBAL_INTERIOR_PLUS_1_(_START_:_STOP_, i), env%mask)
!# define _UNPACK_(in, i, out, env, missing) out(:) = unpack(in(:, i), env%mask, missing)
!# define _UNPACK_TO_PLUS_1_(in, i, out, j, env, missing) out(:, j) = unpack(in(:, i), env%mask, missing)
!# define _UNPACK_AND_ADD_TO_PLUS_1_(in, i, out, j, env) out(:, j) = out(:, j) + unpack(in(:, i), env%mask, 0._rk)
!# define _UNPACK_TO_GLOBAL_(in, i, out, env, missing) out _INDEX_GLOBAL_INTERIOR_(_START_:_STOP_) = unpack(in(:, i), env%mask, missing)
!# define _UNPACK_TO_GLOBAL_PLUS_1_(in, i, out, j, env, missing) out _INDEX_GLOBAL_INTERIOR_PLUS_1_(_START_:_STOP_, j) = unpack(in(:, i), env%mask, missing)
! Using our own arrays with pack/env indices
# define _PACK_GLOBAL_(in,out,i,env) _CONCURRENT_LOOP_BEGIN_EX_(env);out _INDEX_SLICE_PLUS_1_(i) = in _INDEX_GLOBAL_INTERIOR_(env%ipack(_I_));_LOOP_END_
# define _PACK_GLOBAL_PLUS_1_(in,i,out,j,env) _CONCURRENT_LOOP_BEGIN_;out _INDEX_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_INTERIOR_PLUS_1_(env%ipack(_I_),i);_LOOP_END_
# define _UNPACK_(in,i,out,env,missing) _DO_CONCURRENT_(_I_,_START_,_STOP_);if (env%iunpack(_I_)/=0) then;out(_I_) = in(env%iunpack(_I_),i);else;out(_I_) = missing;end if;_LOOP_END_
# define _UNPACK_TO_PLUS_1_(in,i,out,j,env,missing) _DO_CONCURRENT_(_I_,_START_,_STOP_);if (env%iunpack(_I_)/=0) then;out(_I_,j) = in(env%iunpack(_I_),i);else;out(_I_,j) = missing;end if;_LOOP_END_
!# define _UNPACK_AND_ADD_TO_PLUS_1_(in,i,out,j,env) _DO_CONCURRENT_(_I_, _START_, _STOP_);if (env%iunpack(_I_)/=0) then;out(_I_,j) = out(_I_,j) + in(env%iunpack(_I_),i);end if;_LOOP_END_
# define _UNPACK_AND_ADD_TO_PLUS_1_(in,i,out,j,env) _CONCURRENT_LOOP_BEGIN_EX_(env);out(env%ipack(_I_),j) = out(env%ipack(_I_),j) + in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
# define _UNPACK_TO_GLOBAL_(in,i,out,env,missing) _DO_CONCURRENT_(_I_,_START_,_STOP_);if (env%iunpack(_I_)/=0) then;out _INDEX_GLOBAL_INTERIOR_(_I_) = in(env%iunpack(_I_),i);else;out _INDEX_GLOBAL_INTERIOR_(_I_) = missing;end if;_LOOP_END_
# define _UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,env,missing) _DO_CONCURRENT_(_I_,_START_,_STOP_);if (env%iunpack(_I_)/=0) then;out _INDEX_GLOBAL_INTERIOR_PLUS_1_(_I_,j) = in(env%iunpack(_I_),i);else;out _INDEX_GLOBAL_INTERIOR_PLUS_1_(_I_,j) = missing;end if;_LOOP_END_
# define _PACK_GLOBAL_(in,out,i,cache) _CONCURRENT_LOOP_BEGIN_EX_(cache);out _INDEX_SLICE_PLUS_1_(i) = in _INDEX_GLOBAL_INTERIOR_(cache%ipack(_I_));_LOOP_END_
# define _PACK_GLOBAL_PLUS_1_(in,i,out,j,cache) _CONCURRENT_LOOP_BEGIN_;out _INDEX_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_INTERIOR_PLUS_1_(cache%ipack(_I_),i);_LOOP_END_
# define _UNPACK_(in,i,out,cache,missing) out(_START_:_STOP_) = missing;out(cache%ipack(1:cache%n)) = in(1:cache%n,i)
# define _UNPACK_TO_PLUS_1_(in,i,out,j,cache,missing) out(_START_:_STOP_,j) = missing;out(cache%ipack(1:cache%n),j) = in(1:cache%n,i)
# define _UNPACK_AND_ADD_TO_PLUS_1_(in,i,out,j,cache) _CONCURRENT_LOOP_BEGIN_EX_(cache);out(cache%ipack(_I_),j) = out(cache%ipack(_I_),j) + in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
# define _UNPACK_TO_GLOBAL_(in,i,out,cache,missing) out _INDEX_GLOBAL_INTERIOR_(_START_:_STOP_) = missing;out _INDEX_GLOBAL_INTERIOR_(cache%ipack(1:cache%n)) = in(1:cache%n,i);
# define _UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,cache,missing) out _INDEX_GLOBAL_INTERIOR_PLUS_1_(_START_:_STOP_,j) = missing;out _INDEX_GLOBAL_INTERIOR_PLUS_1_(cache%ipack(1:cache%n),j) = in(1:cache%n,i);
#else
# define _PACK_GLOBAL_(in,out,i,env) _CONCURRENT_LOOP_BEGIN_EX_(env);out _INDEX_SLICE_PLUS_1_(i) = in _INDEX_GLOBAL_INTERIOR_(_START_+_I_-1);_LOOP_END_
# define _PACK_GLOBAL_PLUS_1_(in,i,out,j,env) _CONCURRENT_LOOP_BEGIN_EX_(env);out _INDEX_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_INTERIOR_PLUS_1_(_START_+_I_-1,i);_LOOP_END_
# define _UNPACK_(in,i,out,env,missing) _CONCURRENT_LOOP_BEGIN_EX_(env);out _INDEX_EXT_SLICE_ = in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
# define _UNPACK_TO_PLUS_1_(in,i,out,j,env,missing) _CONCURRENT_LOOP_BEGIN_EX_(env);out _INDEX_EXT_SLICE_PLUS_1_(j) = in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
# define _UNPACK_AND_ADD_TO_PLUS_1_(in,i,out,j,env) _CONCURRENT_LOOP_BEGIN_EX_(env);out _INDEX_EXT_SLICE_PLUS_1_(j) = out _INDEX_EXT_SLICE_PLUS_1_(j) + in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
# define _UNPACK_TO_GLOBAL_(in,i,out,env,missing) _CONCURRENT_LOOP_BEGIN_EX_(env);out _INDEX_GLOBAL_INTERIOR_(_START_+_I_-1) = in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
# define _UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,env,missing) _CONCURRENT_LOOP_BEGIN_EX_(env);out _INDEX_GLOBAL_INTERIOR_PLUS_1_(_START_+_I_-1,j) = in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
# define _PACK_GLOBAL_(in,out,i,cache) _CONCURRENT_LOOP_BEGIN_EX_(cache);out _INDEX_SLICE_PLUS_1_(i) = in _INDEX_GLOBAL_INTERIOR_(_START_+_I_-1);_LOOP_END_
# define _PACK_GLOBAL_PLUS_1_(in,i,out,j,cache) _CONCURRENT_LOOP_BEGIN_EX_(cache);out _INDEX_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_INTERIOR_PLUS_1_(_START_+_I_-1,i);_LOOP_END_
# define _UNPACK_(in,i,out,cache,missing) _CONCURRENT_LOOP_BEGIN_EX_(cache);out _INDEX_EXT_SLICE_ = in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
# define _UNPACK_TO_PLUS_1_(in,i,out,j,cache,missing) _CONCURRENT_LOOP_BEGIN_EX_(cache);out _INDEX_EXT_SLICE_PLUS_1_(j) = in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
# define _UNPACK_AND_ADD_TO_PLUS_1_(in,i,out,j,cache) _CONCURRENT_LOOP_BEGIN_EX_(cache);out _INDEX_EXT_SLICE_PLUS_1_(j) = out _INDEX_EXT_SLICE_PLUS_1_(j) + in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
# define _UNPACK_TO_GLOBAL_(in,i,out,cache,missing) _CONCURRENT_LOOP_BEGIN_EX_(cache);out _INDEX_GLOBAL_INTERIOR_(_START_+_I_-1) = in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
# define _UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,cache,missing) _CONCURRENT_LOOP_BEGIN_EX_(cache);out _INDEX_GLOBAL_INTERIOR_PLUS_1_(_START_+_I_-1,j) = in _INDEX_SLICE_PLUS_1_(i);_LOOP_END_
#endif
#if defined(_HORIZONTAL_IS_VECTORIZED_)&&defined(_HAS_MASK_)
! Using pack/unpack intrinsics
!# define _HORIZONTAL_PACK_GLOBAL_(in,out,j,env) out(:,j) = pack(in _INDEX_GLOBAL_HORIZONTAL_(_START_:_STOP_),env%mask)
!# define _HORIZONTAL_PACK_GLOBAL_PLUS_1_(in,i,out,j, env) out(:,j) = pack(in _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(_START_:_STOP_,i), env%mask)
!# define _HORIZONTAL_UNPACK_TO_PLUS_1_(in,i,out,j, env,missing) out(:,j) = unpack(in(:,i), env%mask,missing)
!# define _HORIZONTAL_UNPACK_AND_ADD_TO_PLUS_1_(in,i,out,j, env) out(:,j) = out(:,j) + unpack(in(:,i), env%mask,0._rk)
!# define _HORIZONTAL_UNPACK_TO_GLOBAL_(in,i,out,env,missing) out _INDEX_GLOBAL_HORIZONTAL_(_START_:_STOP_) = unpack(in(:,i), env%mask,missing)
!# define _HORIZONTAL_UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,env,missing) out _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(_START_:_STOP_,j) = unpack(in(:,i),env%mask,missing)
! Using our own arrays with pack/unpack indices
# define _HORIZONTAL_PACK_GLOBAL_(in,out,j,env) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(env);out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_HORIZONTAL_(env%ipack(_J_));_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_PACK_GLOBAL_PLUS_1_(in,i,out,j,env) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_;out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(env%ipack(_J_),i);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_UNPACK_TO_PLUS_1_(in,i,out,j,env,missing) _DO_CONCURRENT_(_J_,_START_,_STOP_);if (env%iunpack(_J_)/=0) then;out(_J_,j) = in(env%iunpack(_J_),i);else;out(_J_,j) = missing;end if;_LOOP_END_
!# define _HORIZONTAL_UNPACK_AND_ADD_TO_PLUS_1_(in,i,out,j, env) _DO_CONCURRENT_(_J_, _START_, _STOP_);if (env%iunpack(_J_)/=0) then;out(_J_,j) = out(_J_,j) + in(env%iunpack(_J_),i);end if;_LOOP_END_
# define _HORIZONTAL_UNPACK_AND_ADD_TO_PLUS_1_(in,i,out,j,env) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(env);out(env%ipack(_J_),j) = out(env%ipack(_J_),j) + in _INDEX_HORIZONTAL_SLICE_PLUS_1_(i);_LOOP_END_
# define _HORIZONTAL_UNPACK_TO_GLOBAL_(in,i,out,env,missing) _DO_CONCURRENT_(_J_,_START_,_STOP_);if (env%iunpack(_J_)/=0) then;out _INDEX_GLOBAL_HORIZONTAL_(_J_) = in(env%iunpack(_J_),i);else;out _INDEX_GLOBAL_HORIZONTAL_(_J_) = missing;end if;_LOOP_END_
# define _HORIZONTAL_UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,env,missing) _DO_CONCURRENT_(_J_,_START_,_STOP_);if (env%iunpack(_J_)/=0) then;out _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(_J_,j) = in(env%iunpack(_J_),i);else;out _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(_J_,j) = missing;end if;_LOOP_END_
# define _HORIZONTAL_PACK_GLOBAL_(in,out,j,cache) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(cache);out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_HORIZONTAL_(cache%ipack(_J_));_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_PACK_GLOBAL_PLUS_1_(in,i,out,j,cache) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_;out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(cache%ipack(_J_),i);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_UNPACK_TO_PLUS_1_(in,i,out,j,cache,missing) out(_START_:_STOP_,j) = missing;out(cache%ipack(1:cache%n),j) = in(1:cache%n,i)
# define _HORIZONTAL_UNPACK_AND_ADD_TO_PLUS_1_(in,i,out,j,cache) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(cache);out(cache%ipack(_J_),j) = out(cache%ipack(_J_),j) + in _INDEX_HORIZONTAL_SLICE_PLUS_1_(i);_LOOP_END_
# define _HORIZONTAL_UNPACK_TO_GLOBAL_(in,i,out,cache,missing) out _INDEX_GLOBAL_HORIZONTAL_(_START_:_STOP_) = missing;out _INDEX_GLOBAL_HORIZONTAL_(cache%ipack(1:cache%n)) = in(1:cache%n,i)
# define _HORIZONTAL_UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,cache,missing) out _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(_START_:_STOP_,j) = missing;out _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(cache%ipack(1:cache%n),j) = in(1:cache%n,i)
#else
# define _HORIZONTAL_PACK_GLOBAL_(in,out,j,env) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(env);out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_HORIZONTAL_(_START_+_J_-1);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_PACK_GLOBAL_PLUS_1_(in,i,out,j,env) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(env);out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(_START_+_J_-1,i);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_UNPACK_TO_PLUS_1_(in,i,out,j,env,missing) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(env);out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = in _INDEX_HORIZONTAL_SLICE_PLUS_1_(i);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_UNPACK_AND_ADD_TO_PLUS_1_(in,i,out,j,env) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(env);out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) + in _INDEX_HORIZONTAL_SLICE_PLUS_1_(i);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_UNPACK_TO_GLOBAL_(in,i,out,env,missing) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(env);out _INDEX_GLOBAL_HORIZONTAL_(_START_+_J_-1) = in _INDEX_HORIZONTAL_SLICE_PLUS_1_(i);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,env,missing) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(env);out _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(_START_+_J_-1,j) = in _INDEX_HORIZONTAL_SLICE_PLUS_1_(i);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_PACK_GLOBAL_(in,out,j,cache) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(cache);out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_HORIZONTAL_(_START_+_J_-1);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_PACK_GLOBAL_PLUS_1_(in,i,out,j,cache) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(cache);out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = in _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(_START_+_J_-1,i);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_UNPACK_TO_PLUS_1_(in,i,out,j,cache,missing) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(cache);out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = in _INDEX_HORIZONTAL_SLICE_PLUS_1_(i);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_UNPACK_AND_ADD_TO_PLUS_1_(in,i,out,j,cache) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(cache);out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) = out _INDEX_HORIZONTAL_SLICE_PLUS_1_(j) + in _INDEX_HORIZONTAL_SLICE_PLUS_1_(i);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_UNPACK_TO_GLOBAL_(in,i,out,cache,missing) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(cache);out _INDEX_GLOBAL_HORIZONTAL_(_START_+_J_-1) = in _INDEX_HORIZONTAL_SLICE_PLUS_1_(i);_HORIZONTAL_LOOP_END_
# define _HORIZONTAL_UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,cache,missing) _CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(cache);out _INDEX_GLOBAL_HORIZONTAL_PLUS_1_(_START_+_J_-1,j) = in _INDEX_HORIZONTAL_SLICE_PLUS_1_(i);_HORIZONTAL_LOOP_END_
#endif
#if defined(_FABM_DEPTH_DIMENSION_INDEX_)&&defined(_HAS_MASK_)
! Using pack/unpack intrinsics
!# define _VERTICAL_UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,env,missing) out _INDEX_GLOBAL_VERTICAL_PLUS_1_(_VERTICAL_START_:_VERTICAL_STOP_,j) = unpack(in(:,i),env%mask,missing)
! Using our own arrays with pack/unpack indices
# define _VERTICAL_UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,env,missing) _DO_CONCURRENT_(_I_,_VERTICAL_START_,_VERTICAL_STOP_);if (env%iunpack(_I_)/=0) then;out _INDEX_GLOBAL_VERTICAL_PLUS_1_(_I_,j) = in(env%iunpack(_I_),i);else;out _INDEX_GLOBAL_VERTICAL_PLUS_1_(_I_,j) = missing;end if;_LOOP_END_
# define _VERTICAL_UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,cache,missing) out _INDEX_GLOBAL_VERTICAL_PLUS_1_(_VERTICAL_START_:_VERTICAL_STOP_,j) = missing;out _INDEX_GLOBAL_VERTICAL_PLUS_1_(cache%ipack(1:cache%n),j) = in(1:cache%n,i)
#else
# define _VERTICAL_UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,env,missing) _CONCURRENT_VERTICAL_LOOP_BEGIN_EX_(env);out _INDEX_GLOBAL_VERTICAL_PLUS_1_(_VERTICAL_START_+_I_-1,j) = in _INDEX_SLICE_PLUS_1_(i);_VERTICAL_LOOP_END_
# define _VERTICAL_UNPACK_TO_GLOBAL_PLUS_1_(in,i,out,j,cache,missing) _CONCURRENT_VERTICAL_LOOP_BEGIN_EX_(cache);out _INDEX_GLOBAL_VERTICAL_PLUS_1_(_VERTICAL_START_+_I_-1,j) = in _INDEX_SLICE_PLUS_1_(i);_VERTICAL_LOOP_END_
#endif
......@@ -4,8 +4,8 @@
#define _FABM_BOTTOM_INDEX_ -1
#define _FABM_MASK_TYPE_ real(rk)
#define _FABM_UNMASKED_VALUE_ 1.
#define _FABM_MASK_TYPE_ real(rke)
#define _FABM_UNMASKED_VALUE_ 1._rke
#include "fabm.h"
......@@ -2564,7 +2564,6 @@ subroutine create_interior_cache(self, cache)
if (n_mod /= 0) n = n - n_mod + array_block_size
# ifdef _HAS_MASK_
allocate(cache%ipack(self%domain_size(_FABM_VECTORIZED_DIMENSION_INDEX_)))
allocate(cache%iunpack(self%domain_size(_FABM_VECTORIZED_DIMENSION_INDEX_)))
# endif
#else
n = 1
......@@ -2599,7 +2598,6 @@ subroutine create_horizontal_cache(self, cache)
if (n_mod /= 0) n = n - n_mod + array_block_size
# ifdef _HAS_MASK_
allocate(cache%ipack(self%domain_size(_FABM_VECTORIZED_DIMENSION_INDEX_)))
allocate(cache%iunpack(self%domain_size(_FABM_VECTORIZED_DIMENSION_INDEX_)))
# endif
#else
n = 1
......@@ -2633,7 +2631,6 @@ subroutine create_vertical_cache(self, cache)
if (n_mod /= 0) n = n - n_mod + array_block_size
# ifdef _HAS_MASK_
allocate(cache%ipack(self%domain_size(_FABM_DEPTH_DIMENSION_INDEX_)))
allocate(cache%iunpack(self%domain_size(_FABM_DEPTH_DIMENSION_INDEX_)))
# endif
#else
n = 1
......@@ -2678,9 +2675,6 @@ subroutine begin_interior_task(self, task, cache _ARGUMENTS_INTERIOR_IN_)
# endif
i = i + 1
cache%ipack(i) = _I_
cache%iunpack(_I_) = i
else
cache%iunpack(_I_) = 0
end if
end do
_N_ = i
......@@ -2736,9 +2730,6 @@ subroutine begin_horizontal_task(self,task,cache _ARGUMENTS_HORIZONTAL_IN_)
if (_IS_UNMASKED_(self%mask_hz _INDEX_GLOBAL_HORIZONTAL_(_J_))) then
i = i + 1
cache%ipack(i) = _J_
cache%iunpack(_J_) = i
else
cache%iunpack(_J_) = 0
end if
end do
_N_ = i
......@@ -2879,9 +2870,6 @@ subroutine begin_vertical_task(self,task,cache _ARGUMENTS_VERTICAL_IN_)
# endif
i = i + 1
cache%ipack(i) = _I_
cache%iunpack(_I_) = i
else
cache%iunpack(_I_) = 0
end if
end do
_N_ = i
......@@ -3741,13 +3729,7 @@ subroutine internal_check_horizontal_state(self,job _ARGUMENTS_HORIZONTAL_IN_, f
#ifdef _HORIZONTAL_IS_VECTORIZED_
# ifdef _HAS_MASK_
_DO_CONCURRENT_(_J_,_START_,_STOP_)
if (self%cache_hz%iunpack(_J_)/=0) then
self%catalog%interior(self%state_variables(ivar)%target%catalog_index)%p _INDEX_GLOBAL_INTERIOR_(_J_) = self%cache_hz%read(self%cache_hz%iunpack(_J_),read_index)
else
self%catalog%interior(self%state_variables(ivar)%target%catalog_index)%p _INDEX_GLOBAL_INTERIOR_(_J_) = self%state_variables(ivar)%missing_value
end if
end do
self%catalog%interior(self%state_variables(ivar)%target%catalog_index)%p _INDEX_GLOBAL_INTERIOR_(self%cache_hz%ipack(1:self%cache_hz%n)) = self%cache_hz%read(1:self%cache_hz%n, read_index)
# else
_CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(self%cache_hz)
self%catalog%interior(self%state_variables(ivar)%target%catalog_index)%p _INDEX_GLOBAL_INTERIOR_(_START_+_I_-1) = self%cache_hz%read _INDEX_SLICE_PLUS_1_(read_index)
......@@ -3762,21 +3744,14 @@ subroutine internal_check_horizontal_state(self,job _ARGUMENTS_HORIZONTAL_IN_, f
#if _FABM_BOTTOM_INDEX_==-1&&defined(_HORIZONTAL_IS_VECTORIZED_)
else
! Special case for bottom if vertical index of bottom point is variable.
# ifdef _HAS_MASK_
_DO_CONCURRENT_(_J_,_START_,_STOP_)
_VERTICAL_ITERATOR_ = self%bottom_indices _INDEX_GLOBAL_HORIZONTAL_(_J_)
if (self%cache_hz%iunpack(_J_)/=0) then
self%catalog%interior(self%state_variables(ivar)%target%catalog_index)%p _INDEX_GLOBAL_INTERIOR_(_J_) = self%cache_hz%read(self%cache_hz%iunpack(_J_),read_index)
else
self%catalog%interior(self%state_variables(ivar)%target%catalog_index)%p _INDEX_GLOBAL_INTERIOR_(_J_) = self%state_variables(ivar)%missing_value
end if
end do
# else
_CONCURRENT_HORIZONTAL_LOOP_BEGIN_EX_(self%cache_hz)
_VERTICAL_ITERATOR_ = self%bottom_indices _INDEX_GLOBAL_HORIZONTAL_(_START_+_J_-1)
# ifdef _HAS_MASK_
self%catalog%interior(self%state_variables(ivar)%target%catalog_index)%p _INDEX_GLOBAL_INTERIOR_(self%cache_hz%ipack(_I_)) = self%cache_hz%read _INDEX_SLICE_PLUS_1_(read_index)
# else
self%catalog%interior(self%state_variables(ivar)%target%catalog_index)%p _INDEX_GLOBAL_INTERIOR_(_START_+_I_-1) = self%cache_hz%read _INDEX_SLICE_PLUS_1_(read_index)
_HORIZONTAL_LOOP_END_
# endif
_HORIZONTAL_LOOP_END_
end if
#endif
end if
......
......@@ -646,14 +646,13 @@
integer :: n = 1
! Read cache (separate interior, horizontal, scalar fields).
real(rk),allocatable _DIMENSION_SLICE_PLUS_1_ :: read
real(rk),allocatable _DIMENSION_HORIZONTAL_SLICE_PLUS_1_ :: read_hz
real(rk),allocatable,dimension(:) :: read_scalar
real(rk), allocatable _DIMENSION_SLICE_PLUS_1_ :: read
real(rk), allocatable _DIMENSION_HORIZONTAL_SLICE_PLUS_1_ :: read_hz
real(rk), allocatable, dimension(:) :: read_scalar
#ifdef _FABM_MASK_TYPE_
! Mask used to transfer data between persistent store and cache [pack/unpack]
integer,allocatable _DIMENSION_SLICE_ :: ipack
integer,allocatable _DIMENSION_SLICE_ :: iunpack
! Indices of non-masked data in masked source arrays
integer, allocatable _DIMENSION_SLICE_ :: ipack
#endif
end type
......
......@@ -169,6 +169,8 @@ _FABM_MASK_TYPE_,allocatable,target _DIMENSION_GLOBAL_ :: mask
integer :: interior_count
integer :: horizontal_count
logical :: no_mask
#if _FABM_BOTTOM_INDEX_==-1
integer,allocatable,target _DIMENSION_GLOBAL_HORIZONTAL_ :: bottom_index
#endif
......@@ -237,6 +239,8 @@ j__=40
k__=45
#endif
no_mask = .true.
#if _FABM_DIMENSION_COUNT_>0
domain_extent = (/ _LOCATION_ /)
interior_count = product(domain_extent)
......@@ -495,6 +499,7 @@ contains
end subroutine read_environment
subroutine randomize_mask
if (.not.no_mask) then
#if _FABM_BOTTOM_INDEX_==-1
! Depth index of bottom varies in the horizontal
call random_number(tmp_hz)
......@@ -516,13 +521,7 @@ contains
! Apply random mask across horizontal domain (half of grid cells masked)
call random_number(tmp_hz)
mask_hz = _FABM_UNMASKED_VALUE_
where (tmp_hz>0.5_rk) mask_hz = _FABM_MASKED_VALUE_
horizontal_count = count(_IS_UNMASKED_(mask_hz))
# ifdef _FABM_DEPTH_DIMENSION_INDEX_
interior_count = horizontal_count * domain_extent(_FABM_DEPTH_DIMENSION_INDEX_)
# else
interior_count = horizontal_count
# endif
where (tmp_hz>0.5_rke) mask_hz = _FABM_MASKED_VALUE_
# else
! Apply random mask across interior domain (half of grid cells masked)
call random_number(tmp)
......@@ -556,6 +555,37 @@ contains
# endif
end if
_END_GLOBAL_HORIZONTAL_LOOP_
# endif
#endif
else
#if _FABM_BOTTOM_INDEX_==-1
# ifdef _FABM_VERTICAL_BOTTOM_TO_SURFACE_
bottom_index = 1
# else
bottom_index = domain_extent(_FABM_DEPTH_DIMENSION_INDEX_)
# endif
#endif
#ifdef _HAS_MASK_
# ifndef _FABM_HORIZONTAL_MASK_
mask = _FABM_UNMASKED_VALUE_
# endif
mask_hz = _FABM_UNMASKED_VALUE_
#endif
end if
call count_active_points()
end subroutine randomize_mask
subroutine count_active_points()
#ifdef _HAS_MASK_
# ifdef _FABM_HORIZONTAL_MASK_
horizontal_count = count(_IS_UNMASKED_(mask_hz))
# ifdef _FABM_DEPTH_DIMENSION_INDEX_
interior_count = horizontal_count * domain_extent(_FABM_DEPTH_DIMENSION_INDEX_)
# else
interior_count = horizontal_count
# endif
# else
horizontal_count = count(_IS_UNMASKED_(mask_hz))
interior_count = count(_IS_UNMASKED_(mask))
# endif
......@@ -568,8 +598,8 @@ contains
interior_count = sum(bottom_index)
# endif
#endif
end subroutine randomize_mask
end subroutine
subroutine simulate(n)
integer, intent(in) :: n
real(rke) :: time_begin, time_end
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment