Replaced `where` constructs by loops after memory errors on some systems. (8afcdee1) · Commits · CAMS / CSO

oper/src/cso_ncfile.F90

+87 −21

Original line number	Diff line number	Diff line
		@@ -7,9 +7,13 @@
		!
		! 2022-09, Arjo Segers
		! Support input and output of packed variables.
		!
		! 2022-10, Arjo Segers
		! Do not copy packing attributes from input files.
		!
		! 2023-08, Arjo Segers
		! Replaced `where` constructs by loops after memory errors on some systems.
		!
		!###############################################################################
		!
		#define TRACEBACK write (csol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call csoErr
		@@ -4082,6 +4086,7 @@ contains
		integer(iwp__packed), allocatable :: values__packed(:,:)
		real :: vmin, vmax
		real :: add_offset, scale_factor
		integer :: i, j

		! --- begin ----------------------------------

		@@ -4123,15 +4128,29 @@ contains

		! need to check on no-data values?
		if ( present(fill_value) ) then

		! encode into packed variable, except for no-data values:
		where ( values == fill_value )
		values__packed = fill_value__packed
		elsewhere
		values__packed = int( ( values - add_offset )/scale_factor, kind=iwp__packed )
		end where
		!where ( values == fill_value )
		! values__packed = fill_value__packed
		!elsewhere
		! values__packed = int( ( values - add_offset )/scale_factor, kind=iwp__packed )
		!end where
		! ... on some systems, the above seems too heavy ...
		do j = 1, size(values,2)
		do i = 1, size(values,1)
		if ( values(i,j) == fill_value ) then
		values__packed(i,j) = fill_value__packed
		else
		values__packed(i,j) = int( ( values(i,j) - add_offset )/scale_factor, kind=iwp__packed )
		end if
		end do ! i
		end do ! j

		else

		! encode into packed variable:
		values__packed = int( ( values - add_offset )/scale_factor, kind=iwp__packed )

		end if ! check on fill_value

		! write packed values:
		@@ -4161,15 +4180,29 @@ contains
		write (csol,'("either none or both arguments `fill_value` and `` should be present")'); call csoErr
		TRACEBACK; status=1; return
		end if

		! copy to output precission with change of fill values:
		where ( values == fill_value )
		values__out = fill_value__out
		elsewhere
		values__out = real(values,kind=rwp__out)
		end where
		!where ( values == fill_value )
		! values__out = fill_value__out
		!elsewhere
		! values__out = real(values,kind=rwp__out)
		!end where
		! ... on some systems, the above seems too heavy ...
		do j = 1, size(values,2)
		do i = 1, size(values,1)
		if ( values(i,j) == fill_value ) then
		values__out(i,j) = fill_value__out
		else
		values__out(i,j) = real(values(i,j),kind=rwp__out)
		end if
		end do ! i
		end do ! j

		else

		! copy:
		values__out = real(values,kind=rwp__out)

		end if

		! write:
		@@ -4228,6 +4261,7 @@ contains
		integer(iwp__packed), allocatable :: values__packed(:,:,:)
		real :: vmin, vmax
		real :: add_offset, scale_factor
		integer :: i, j, k

		! --- begin ----------------------------------

		@@ -4269,15 +4303,31 @@ contains

		! need to check on no-data values?
		if ( present(fill_value) ) then

		! encode into packed variable, except for no-data values:
		where ( values == fill_value )
		values__packed = fill_value__packed
		elsewhere
		values__packed = int( ( values - add_offset )/scale_factor, kind=iwp__packed )
		end where
		!where ( values == fill_value )
		! values__packed = fill_value__packed
		!elsewhere
		! values__packed = int( ( values - add_offset )/scale_factor, kind=iwp__packed )
		!end where
		! ... on some systems, the above seems too heavy ...
		do k = 1, size(values,3)
		do j = 1, size(values,2)
		do i = 1, size(values,1)
		if ( values(i,j,k) == fill_value ) then
		values__packed(i,j,k) = fill_value__packed
		else
		values__packed(i,j,k) = int( ( values(i,j,k) - add_offset )/scale_factor, kind=iwp__packed )
		end if
		end do ! i
		end do ! j
		end do

		else

		! encode into packed variable:
		values__packed = int( ( values - add_offset )/scale_factor, kind=iwp__packed )

		end if ! check on fill_value

		! write packed values:
		@@ -4307,15 +4357,31 @@ contains
		write (csol,'("either none or both arguments `fill_value` and `` should be present")'); call csoErr
		TRACEBACK; status=1; return
		end if

		! copy to output precission with change of fill values:
		where ( values == fill_value )
		values__out = fill_value__out
		elsewhere
		values__out = real(values,kind=rwp__out)
		end where
		!where ( values == fill_value )
		! values__out = fill_value__out
		!elsewhere
		! values__out = real(values,kind=rwp__out)
		!end where
		! ... on some systems, the above seems too heavy ...
		do k = 1, size(values,3)
		do j = 1, size(values,2)
		do i = 1, size(values,1)
		if ( values(i,j,k) == fill_value ) then
		values__out(i,j,k) = fill_value__out
		else
		values__out(i,j,k) = real(values(i,j,k),kind=rwp__out)
		end if
		end do ! i
		end do ! j
		end do

		else

		! copy:
		values__out = real(values,kind=rwp__out)

		end if

		! write: