Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

mixed precision time_interp #1252

Merged
merged 34 commits into from
Aug 3, 2023
Merged

mixed precision time_interp #1252

Show file tree
Hide file tree
Changes from 33 commits
Commits
Show all changes
34 commits
Select commit Hold shift + click to select a range
46d8e44
Update mixedmode_base branch to main (#1144)
mlee03 Mar 8, 2023
dde0b88
update the mixedmode_base branch to main (#1154)
mlee03 Mar 15, 2023
bc9e4d9
Merge branch 'mixedmode' into mixedmode_base
rem1776 Apr 5, 2023
2977578
rm accidental empty line
Apr 5, 2023
b3374f6
chore: bring mixedmode_base up to date with main (#1173)
mlee03 Apr 5, 2023
cca0c7d
chore: update mixedmode_base to main (#1234)
mlee03 May 24, 2023
2795ed2
restructure with includes for both modules
May 26, 2023
99980a2
add test/build changes for time_interp mod
May 30, 2023
9075302
add in tests, more changes for _external module
May 31, 2023
f2ddd83
Merge branch 'mixedmode' of github.com:noaa-gfdl/FMS into time_interp…
May 31, 2023
2d4c4d8
fix for horiz_interp type mismatch in load_record
Jun 1, 2023
3e47f37
clean up and fix implicit kinds
Jun 7, 2023
eab2cba
Merge remote-tracking branch 'origin/mixedmode' into time_interp_merge
Jun 7, 2023
c50d55c
remove missed time_interp_external routines from module
Jun 7, 2023
a0897a5
missed some static reals, rename field_ptr
Jun 7, 2023
8878b54
fix indents
Jun 28, 2023
e19a188
clean up
Jun 28, 2023
5ec7ac6
linter fixes
Jul 5, 2023
712330b
chore: merge main updates into mixedmode_base(#1267)
mlee03 Jul 7, 2023
673b901
Merge remote-tracking branch 'origin/mixedmode_base' into ti_bkup
Jul 11, 2023
1389016
fix allocatable issues with gcc, remove duplicate test dir
Jul 12, 2023
109aa21
fix test failure from horiz_interp bug, add checks to test
Jul 14, 2023
7fb5628
Merge remote-tracking branch 'origin/mixedmode' into time_interp_merge
Jul 14, 2023
40712be
linter fixes
Jul 14, 2023
94434d9
fix redudant parameter val
Jul 14, 2023
8c72630
mixed-precision: update mixedmode base (#1289)
mlee03 Jul 26, 2023
75a6b7f
fix real cast
Jul 28, 2023
8775ced
some test changes
Jul 28, 2023
608abb7
Merge remote-tracking branch 'origin/mixedmode_base' into time_interp…
Jul 28, 2023
3a7d6b2
fix gcc failures
Jul 28, 2023
8be0313
add tests for more coverage
Jul 28, 2023
81a9fa9
Merge remote-tracking branch 'origin/mixedmode' into time_interp_merge
Jul 31, 2023
27f31d0
linter fixes
Aug 2, 2023
499865b
remove duplicate loop in monin
Aug 2, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -313,6 +313,7 @@ foreach(kind ${kinds})
constants
axis_utils/include
field_manager/include
time_interp/include
tracer_manager/include)

target_compile_definitions(${libTgt}_f PRIVATE "${fms_defs}")
Expand Down
4 changes: 2 additions & 2 deletions horiz_interp/horiz_interp_type.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -81,7 +81,7 @@ module horiz_interp_type_mod
real(kind=r8_kind), dimension(:), allocatable :: area_frac_dst !< area fraction in destination grid.
real(kind=r8_kind), dimension(:,:), allocatable :: mask_in
real(kind=r8_kind) :: max_src_dist
logical :: is_allocated !< set to true upon field allocation
logical :: is_allocated = .false. !< set to true upon field allocation

end type horizInterpReals8_type

Expand All @@ -108,7 +108,7 @@ module horiz_interp_type_mod
real(kind=r4_kind), dimension(:), allocatable :: area_frac_dst !< area fraction in destination grid.
real(kind=r4_kind), dimension(:,:), allocatable :: mask_in
real(kind=r4_kind) :: max_src_dist
logical :: is_allocated !< set to true upon field allocation
logical :: is_allocated = .false. !< set to true upon field allocation

end type horizInterpReals4_type

Expand Down
5 changes: 5 additions & 0 deletions monin_obukhov/include/monin_obukhov.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -123,6 +123,11 @@ do j=1, n3
enddo
enddo

do j=1, n3
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

ah it did that for you too! the do loops are repeated here

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

i think something wonky might be happening with our branches, might be better to simplify things and just use mixedmode as the starting point going forward

do i=1, n2
call stable_mix(rich(:, i, j), mix(:, i, j))
enddo
enddo


end subroutine STABLE_MIX_3D_
Expand Down
15 changes: 12 additions & 3 deletions test_fms/time_interp/Makefile.am
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,11 +29,20 @@ AM_CPPFLAGS = -I$(MODDIR)
LDADD = $(top_builddir)/libFMS/libFMS.la

# Build these test programs.
check_PROGRAMS = test_time_interp test_time_interp_external
check_PROGRAMS = test_time_interp_r4 test_time_interp_r8 test_time_interp_external_r4 test_time_interp_external_r8

# These are the sources for the tests.
test_time_interp_SOURCES = test_time_interp.F90
test_time_interp_external_SOURCES = test_time_interp_external.F90
test_time_interp_r4_SOURCES = test_time_interp.F90
test_time_interp_r8_SOURCES = test_time_interp.F90
test_time_interp_external_r4_SOURCES = test_time_interp_external.F90
test_time_interp_external_r8_SOURCES = test_time_interp_external.F90

# filter out any added precision flags
# adds r8 flag, otherwise no-flag default is 4
test_time_interp_r4_CPPFLAGS=-DTI_TEST_KIND_=4 -I$(MODDIR)
test_time_interp_r8_CPPFLAGS=-DTI_TEST_KIND_=8 -I$(MODDIR)
test_time_interp_external_r4_CPPFLAGS=-DTI_TEST_KIND_=4 -I$(MODDIR)
test_time_interp_external_r8_CPPFLAGS=-DTI_TEST_KIND_=8 -I$(MODDIR)

# Run the test programs.
TESTS = test_time_interp2.sh
Expand Down
93 changes: 87 additions & 6 deletions test_fms/time_interp/test_time_interp.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,19 +23,24 @@ program test_time_interp
use time_manager_mod, only: get_date, set_time, set_date, time_manager_init, set_calendar_type, operator(+)
use time_manager_mod, only: JULIAN, time_type, increment_time, NOLEAP, print_date
use time_interp_mod, only: time_interp_init, time_interp, NONE, YEAR, MONTH, DAY
use time_manager_mod, only: operator(<=), operator(>=), operator(==)
use platform_mod

implicit none

integer, parameter :: num_Time=6
integer, parameter :: num_Time=6, kindl = TI_TEST_KIND_
type(time_type) :: Time_beg, Time_end, Time(num_Time)
type(time_type), allocatable, dimension(:) :: Timelist
integer :: index1, index2, mo, yr, timelist_len, outunit, ntest, nline
real :: weight
integer :: index1, index2, mo, yr, outunit, ntest, nline
real(TI_TEST_KIND_) :: weight
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It seems like the test is a guide on how to use time_interp. Is there a way to check that the answers are as expected?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I added checks for all but the last, since that one cycles through instead of going to set dates.

real(TI_TEST_KIND_) :: ref_weights(num_Time), ref_weights_leap(num_Time)
real(TI_TEST_KIND_), parameter :: SMALL = 1.0e-7_kindl ! r4 will fail with 8
real(TI_TEST_KIND_), parameter :: midpoint = 0.483870967741935_kindl
real(TI_TEST_KIND_), parameter :: day_before_leap_day = 0.964285714285714_kindl
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

where did these numbers come from?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Just reference weights from the calculation, its a fraction of time passed over a interval. So for this its the midway point of a month (jan 16). I think i commented on it a bit lower down.

I might be able to replace these with the actual time_type calculation if thats preferred, i guess i just like seeing what the actual value ends up as.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

could the actual time_type calculation be used and add the numbers as comments? Is this perhaps the reason you're not getting exactly agreeing answers?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

After looking into it i don't think i can reproduce the calculation unless i copy in a whole routine (set_modtime). I think this way has some benefits though, like if the time_type arithmentic overrides return the wrong thing a check with the same operations will just be checking wrong answers against wrong answers.

real(TI_TEST_KIND_), parameter :: day_before_leap_day_with_ly = 0.931034482758621_kindl

integer :: nmin, nmax

namelist / test_time_interp_nml / timelist_len

call fms_init
outunit = stdout()
call set_calendar_type(JULIAN)
Expand All @@ -50,8 +55,23 @@ program test_time_interp
Time(5) = set_date(1,12,16)
Time(6) = Time_end

ref_weights(1) = 0.0 ! on 'edge' (timeList value)
ref_weights(2) = midpoint ! rough midpoint of a month ie. jan 16
ref_weights(3) = 0.0
ref_weights(4) = 0.0
ref_weights(5) = midpoint
ref_weights(6) = 0.0

ref_weights_leap(1) = 0.0 ! on 'edge' (timeList value)
ref_weights_leap(2) = day_before_leap_day ! feb 28th
ref_weights_leap(3) = midpoint
ref_weights_leap(4) = 0.0
ref_weights_leap(5) = day_before_leap_day
ref_weights_leap(6) = day_before_leap_day ! checks that 29th gives same result

! Tests with modulo time
do nline=1,3

if(nline == 1) then
allocate(Timelist(12))
do mo=1,12
Expand All @@ -72,6 +92,7 @@ program test_time_interp
endif

do ntest=1,num_Time
print *, ntest
call diagram(nline,ntest,modulo_time=.true.)
call time_interp(Time(ntest), Time_beg, Time_end, Timelist, weight, index1, index2)
write(outunit,*) 'time_interp_modulo:'
Expand All @@ -84,17 +105,30 @@ program test_time_interp
write(outunit,99) index1,index2,weight
write(outunit,'()')

if(.not. is_valid_indices(index1, index2, Timelist, Time(ntest), weight, YEAR)) &
call mpp_error(FATAL, "test_time_interp: invalid indices from time_interp_timelist")
if(abs(weight - ref_weights(ntest)) .gt. SMALL) &
call mpp_error(FATAL, "test_time_interp: incorrect weight value with reference")

call time_interp(Time(ntest), Timelist, weight, index1, index2, modtime=YEAR)
write(outunit,*) 'time_interp_list with modtime=YEAR:'
write(outunit,'()')
call print_date(Time(ntest), 'Time =')
call print_date(Timelist(1), 'Timelist(1)=')
call print_date(Timelist(size(Timelist(:))),'Timelist(n)=')
write(outunit,99) index1,index2,weight

if(.not. is_valid_indices(index1, index2, Timelist, Time(ntest), weight, YEAR)) &
call mpp_error(FATAL, "test_time_interp: invalid indices from time_interp_modulo")
if(abs(weight - ref_weights(ntest)) .gt. SMALL) &
call mpp_error(FATAL, "test_time_interp: incorrect weight value with reference")

enddo
deallocate(Timelist)
enddo



! Tests without modulo time
do nline=1,3
if(nline == 1) then
Expand Down Expand Up @@ -132,6 +166,12 @@ program test_time_interp
call print_date(Timelist(1), 'Timelist(1)=')
call print_date(Timelist(size(Timelist(:))),'Timelist(n)=')
write(outunit,99) index1,index2,weight

if( .not. is_valid_indices(index1, index2, TimeList, Time(ntest), weight, NONE)) &
call mpp_error(FATAL, "invalid result without modtime")
if(abs(weight - ref_weights(ntest)) .gt. SMALL) &
call mpp_error(FATAL, "test_time_interp: incorrect weight value with reference")

enddo
deallocate(Timelist)
enddo
Expand Down Expand Up @@ -171,9 +211,20 @@ program test_time_interp
call print_date(Time(ntest),' Time =')
write(outunit,99) index1,index2,weight
write(outunit,'()')
if( .not. is_valid_indices(index1, index2, Timelist, Time(ntest), weight, YEAR)) &
call mpp_error(FATAL, 'invalid results for indices with leap year correction')
if(abs(weight - ref_weights_leap(ntest)) .gt. SMALL) &
call mpp_error(FATAL, "test_time_interp: incorrect weight value with reference")
enddo
deallocate(Timelist)

! swap around ref numbers for different data set
ref_weights_leap(1) = day_before_leap_day
ref_weights_leap(2) = day_before_leap_day ! feb 28th
ref_weights_leap(3) = 0.0
ref_weights_leap(4) = day_before_leap_day_with_ly
ref_weights_leap(5) = 0.0
ref_weights_leap(6) = 0.0
! Tests of modulo time and leap year inconsistency
Time_beg = set_date(1978, 1, 1)
Time_end = set_date(1981, 1, 1)
Expand Down Expand Up @@ -210,6 +261,10 @@ program test_time_interp
call print_date(Time(ntest),' Time=')
write(outunit,99) index1,index2,weight
write(outunit,'()')
if( .not. is_valid_indices(index1, index2, Timelist, Time(ntest), weight, YEAR)) &
call mpp_error(FATAL, 'invalid results for indices with leap year correction')
if(abs(weight - ref_weights_leap(ntest)) .gt. SMALL) &
call mpp_error(FATAL, "test_time_interp: incorrect weight value with reference")
enddo
deallocate(Timelist)

Expand Down Expand Up @@ -297,4 +352,30 @@ subroutine diagram(nline,ntest,modulo_time)

end subroutine diagram

end program test_time_interp
!> helper function to check results
!! true if invalid , false for valid
logical function is_valid_indices(ind1, ind2, tList, tintv, res_weight, mtime)
integer, intent(in) :: ind1, ind2
type(time_type), intent(in) :: tList(:), tintv
real(TI_TEST_KIND_), intent(in) :: res_weight
integer, intent(in) :: mtime
integer :: i

! modulo_time determines wrap around
if( mtime .eq. NONE) then
if (ind1 .eq. SIZE(tList)) then
is_valid_indices = ind2 .eq. ind1
else
is_valid_indices = ind2 .eq. ind1+1
endif
else ! YEAR, default
if (ind1 .eq. 12 ) then
is_valid_indices = ind2 .eq. 1
else
is_valid_indices = ind2 .eq. ind1+1
endif
endif

end function is_valid_indices

end program test_time_interp
32 changes: 27 additions & 5 deletions test_fms/time_interp/test_time_interp2.sh
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@
# This is part of the GFDL FMS package. This is a shell script to
# execute tests in the test_fms/mpp directory.

# Ed Hartnett 11/29/19
# Ed Hartnett 11/49/19

# Set common test settings.
. ../test-lib.sh
Expand All @@ -33,14 +33,36 @@ touch input.nml
rm -rf INPUT
mkdir INPUT
# Run the test.
test_expect_success "test time interpolation" '
mpirun -n 2 ./test_time_interp
test_expect_success "test time interpolation with r8_kind" '
mpirun -n 4 ./test_time_interp_r8
'
test_expect_success "test time interpolation with r4_kind" '
mpirun -n 4 ./test_time_interp_r4
'

rm -rf INPUT
mkdir INPUT

test_expect_success "test time interpolation external" '
mpirun -n 2 ./test_time_interp_external
# nml for calender type
cat <<_EOF > input.nml
&test_time_interp_external_nml
cal_type="julian"
/
_EOF

test_expect_success "test time interpolation external with r8_kind (julian)" '
mpirun -n 4 ./test_time_interp_external_r8
'
test_expect_success "test time interpolation external with r4_kind (julian)" '
mpirun -n 4 ./test_time_interp_external_r4
'
sed -i 's/julian/no_leap/' input.nml

test_expect_success "test time interpolation external with r8_kind (no_leap)" '
mpirun -n 4 ./test_time_interp_external_r8
'
test_expect_success "test time interpolation external with r4_kind (no_leap)" '
mpirun -n 4 ./test_time_interp_external_r4
'

test_done
Loading
Loading