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

update sat_vapor_pres bad temperature output to use mpp_error #1619

Open
wants to merge 2 commits into
base: main
Choose a base branch
from
+78 −17
Open

update sat_vapor_pres bad temperature output to use mpp_error #1619

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
2bb4762
update show_all_bad in sat_vapor_pres to use mpp_error for warning ou…
Dec 3, 2024
9172483
remove duplicate pe in error message, add tests
Dec 3, 2024
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
29 changes: 16 additions & 13 deletions sat_vapor_pres/include/sat_vapor_pres.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1878,7 +1878,8 @@

subroutine SHOW_ALL_BAD_0D_ ( temp )
real(kind=FMS_SVP_KIND_) , intent(in) :: temp !< temperature in degrees Kelvin (K)
integer :: ind, iunit
integer :: ind
character(len=256) :: output_msg
!> DTINV, TMIN, TEPS are module level variables declared in r8_kind
!! Thus they need to be converted to FMS_SVP_KIND_
real(FMS_SVP_KIND_) :: dtinvll !< local version of module variable dtinvl
Expand All @@ -1889,10 +1890,10 @@
tminll=real(tmin,FMS_SVP_KIND_)
tepsll=real(teps,FMS_SVP_KIND_)

iunit = stdoutunit
ind = int( dtinvll*(temp-tminll+tepsll) )
if (ind < 0 .or. ind > nlim) then
write(iunit,'(a,e10.3,a,i6)') 'Bad temperature=',temp,' pe=',mpp_pe()
write(output_msg,'(a,e10.3)') 'Bad temperature=',temp
call mpp_error(WARNING, output_msg)
endif

end subroutine SHOW_ALL_BAD_0D_
Expand All @@ -1901,7 +1902,8 @@

subroutine SHOW_ALL_BAD_1D_ ( temp )
real(kind=FMS_SVP_KIND_) , intent(in) :: temp(:) !< temperature in degrees Kelvin (K)
integer :: i, ind, iunit
integer :: i, ind
character(len=256) :: output_msg
!> DTINV, TMIN, TEPS are module level variables declared in r8_kind
!! Thus they need to be converted to FMS_SVP_KIND_
real(FMS_SVP_KIND_) :: dtinvll !< local version of module variable dtinvl
Expand All @@ -1912,11 +1914,11 @@
tminll=real(tmin,FMS_SVP_KIND_)
tepsll=real(teps,FMS_SVP_KIND_)

iunit = stdoutunit
do i=1,size(temp)
ind = int( dtinvll*(temp(i)-tminll+tepsll) )
if (ind < 0 .or. ind > nlim) then
write(iunit,'(a,e10.3,a,i4,a,i6)') 'Bad temperature=',temp(i),' at i=',i,' pe=',mpp_pe()
write(output_msg,'(a,e10.3,a,i4)') 'Bad temperature=',temp(i),' at i=',i
call mpp_error(WARNING,output_msg)
endif
enddo

Expand All @@ -1926,7 +1928,8 @@

subroutine SHOW_ALL_BAD_2D_ ( temp )
real(kind=FMS_SVP_KIND_) , intent(in) :: temp(:,:) !< temperature in degrees Kelvin (K)
integer :: i, j, ind, iunit
integer :: i, j, ind
character(len=256) :: output_msg
!> DTINV, TMIN, TEPS are module level variables declared in r8_kind
!! Thus they need to be converted to FMS_SVP_KIND_
real(FMS_SVP_KIND_) :: dtinvll !< local version of module variable dtinvl
Expand All @@ -1937,12 +1940,12 @@
tminll=real(tmin,FMS_SVP_KIND_)
tepsll=real(teps,FMS_SVP_KIND_)

iunit = stdoutunit
do j=1,size(temp,2)
do i=1,size(temp,1)
ind = int( dtinvll*(temp(i,j)-tminll+tepsll) )
if (ind < 0 .or. ind > nlim) then
write(iunit,'(a,e10.3,a,i4,a,i4,a,i6)') 'Bad temperature=',temp(i,j),' at i=',i,' j=',j,' pe=',mpp_pe()
write(output_msg,'(a,e10.3,a,i4,a,i4)') 'Bad temperature=',temp(i,j),' at i=',i,' j=',j
call mpp_error(WARNING, output_msg)
endif
enddo
enddo
Expand All @@ -1953,7 +1956,8 @@

subroutine SHOW_ALL_BAD_3D_ ( temp )
real(kind=FMS_SVP_KIND_), intent(in) :: temp(:,:,:) !< temperature in degrees Kelvin (K)
integer :: i, j, k, ind, iunit
integer :: i, j, k, ind
character(len=256) :: output_msg
!> DTINV, TMIN, TEPS are module level variables declared in r8_kind
!! Thus they need to be converted to FMS_SVP_KIND_
real(FMS_SVP_KIND_) :: dtinvll !< local version of module variable dtinvl
Expand All @@ -1964,14 +1968,13 @@
tminll=real(tmin,FMS_SVP_KIND_)
tepsll=real(teps,FMS_SVP_KIND_)

iunit = stdoutunit
do k=1,size(temp,3)
do j=1,size(temp,2)
do i=1,size(temp,1)
ind = int( dtinvll*(temp(i,j,k)-tminll+tepsll) )
if (ind < 0 .or. ind > nlim) then
write(iunit,'(a,e10.3,a,i4,a,i4,a,i4,a,i6)') 'Bad temperature=',temp(i,j,k),' at i=',i,' j=',j,' k=',k, &
& ' pe=',mpp_pe()
write(output_msg,'(a,e10.3,a,i4,a,i4,a,i4)') 'Bad temperature=',temp(i,j,k),' at i=',i,' j=',j,' k=',k
call mpp_error(WARNING, output_msg)
endif
enddo
enddo
Expand Down
2 changes: 1 addition & 1 deletion sat_vapor_pres/sat_vapor_pres.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -180,7 +180,7 @@ module sat_vapor_pres_mod

use constants_mod, only: TFREEZE, RDGAS, RVGAS, HLV, ES0
use fms_mod, only: write_version_number, stdout, stdlog, mpp_pe, mpp_root_pe, &
mpp_error, FATAL, fms_error_handler, &
mpp_error, FATAL, WARNING, fms_error_handler, &
error_mesg, check_nml_error
use mpp_mod, only: input_nml_file
use sat_vapor_pres_k_mod, only: sat_vapor_pres_init_k, lookup_es_k, &
Expand Down
15 changes: 13 additions & 2 deletions test_fms/sat_vapor_pres/test_sat_vapor_pres.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@
program test_sat_vap_pressure

use fms_mod, only: fms_init, fms_end
use mpp_mod, only: mpp_error, FATAL
use mpp_mod, only: mpp_error, FATAL, mpp_pe
use platform_mod, only: r4_kind, r8_kind
use constants_mod, only: RDGAS, RVGAS, TFREEZE
use sat_vapor_pres_mod, only: TCMIN, TCMAX, sat_vapor_pres_init, &
Expand All @@ -55,7 +55,8 @@ program test_sat_vap_pressure
integer :: nml_unit_var
character(*), parameter :: nml_file = 'test_sat_vapor_pres.nml'
logical :: test1, test2, test3, test4, test5
NAMELIST / test_sat_vapor_pres_nml/ test1, test2, test3, test4, test5
integer :: test_show_all_bad = -1 !< dimension to test show_all_bad interface with
NAMELIST / test_sat_vapor_pres_nml/ test1, test2, test3, test4, test5, test_show_all_bad

N=(TCMAX-TCMIN)*ESRES+1
allocate( TABLE(N),DTABLE(N),TABLE2(N),DTABLE2(N),TABLE3(N),DTABLE3(N) )
Expand Down Expand Up @@ -199,6 +200,10 @@ subroutine test_lookup_es_des
!! at temp=TCMIN, the answers should be TABLE(1)
temp = real(TCMIN,lkind) + real(TFREEZE,lkind)
esat_answer = real(TABLE(1), lkind)

! check out of range temp value (100k)
if(test_show_all_bad .eq. 0 .and. mpp_pe() .eq. 1) temp = real(100.0,lkind)

call lookup_es(temp,esat)
call check_answer_0d(esat_answer, esat, 'test_lookup_es_0d TCMIN')
!! at temp=TCMAX, the answers should be TABLE(N)
Expand Down Expand Up @@ -242,6 +247,8 @@ subroutine test_lookup_es_des
!> test lookup_es
!! at temp=TCMIN, the answers should be TABLE(1)
temp_1d(1) = real(TCMIN,lkind) + real(TFREEZE,lkind)
! check out of range temp value (100k)
if(test_show_all_bad .eq. 1 .and. mpp_pe() .eq. 1) temp_1d = real(100.0,lkind)
esat_answer_1d = TABLE(1)
call lookup_es(temp_1d,esat_1d)
call check_answer_1d(esat_answer_1d, esat_1d, 'test_lookup_es_1d TCMIN')
Expand Down Expand Up @@ -285,6 +292,8 @@ subroutine test_lookup_es_des
!> test lookup_es
!! at temp=TCMIN, the answers should be TABLE(1)
temp_2d(1,1) = real(TCMIN,lkind) + real(TFREEZE,lkind)
! check out of range temp value (100k)
if(test_show_all_bad .eq. 2 .and. mpp_pe() .eq. 1) temp_2d = real(100.0,lkind)
esat_answer_2d = real(TABLE(1),lkind)
call lookup_es(temp_2d,esat_2d)
call check_answer_2d(esat_answer_2d, esat_2d, 'test_lookup_es_2d TCMIN')
Expand Down Expand Up @@ -328,6 +337,8 @@ subroutine test_lookup_es_des
!> test lookup_es
!! at temp=TCMIN, the answers should be TABLE(1)
temp_3d(1,1,1) = real(TCMIN,lkind) + real(TFREEZE,lkind)
! check out of range temp value (100k)
if(test_show_all_bad .eq. 3 .and. mpp_pe() .eq. 1) temp_3d = real(100.0,lkind)
esat_answer_3d = TABLE(1)
call lookup_es(temp_3d,esat_3d)
call check_answer_3d(esat_answer_3d, esat_3d, 'test_lookup_es_3d precision TCMIN')
Expand Down
49 changes: 48 additions & 1 deletion test_fms/sat_vapor_pres/test_sat_vapor_pres.sh
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,8 @@ cat << EOF > input.nml
&sat_vapor_pres_nml
construct_table_wrt_liq = .true.,
construct_table_wrt_liq_and_ice = .true.,
use_exact_qs = .true.
use_exact_qs = .true.,
show_all_bad_values = .true.
/
EOF

Expand Down Expand Up @@ -113,4 +114,50 @@ test_expect_success "test_lookup_es3_des3_r8" '
mpirun -n 1 ./test_sat_vapor_pres_r8
'

## test failures when out of range temps are used
cat <<EOF > test_sat_vapor_pres.nml
&test_sat_vapor_pres_nml
test1=.false.
test2=.false.
test3=.true.
test4=.false.
test5=.false.
test_show_all_bad = 0
/
EOF

test_expect_failure "check bad temperature values 0d r4" '
mpirun -n 2 ./test_sat_vapor_pres_r4
'
test_expect_failure "check bad temperature values 0d r8" '
mpirun -n 2 ./test_sat_vapor_pres_r8
'

sed -i 's/test_show_all_bad = 0/test_show_all_bad = 1/' test_sat_vapor_pres.nml

test_expect_failure "check bad temperature values 1d r4" '
mpirun -n 2 ./test_sat_vapor_pres_r4
'
test_expect_failure "check bad temperature values 1d r8" '
mpirun -n 2 ./test_sat_vapor_pres_r8
'

sed -i 's/test_show_all_bad = 1/test_show_all_bad = 2/' test_sat_vapor_pres.nml

test_expect_failure "check bad temperature values 2d r4" '
mpirun -n 2 ./test_sat_vapor_pres_r4
'
test_expect_failure "check bad temperature values 2d r8" '
mpirun -n 2 ./test_sat_vapor_pres_r8
'

sed -i 's/test_show_all_bad = 2/test_show_all_bad = 3/' test_sat_vapor_pres.nml

test_expect_failure "check bad temperature values 3d r4" '
mpirun -n 2 ./test_sat_vapor_pres_r4
'
test_expect_failure "check bad temperature values 3d r8" '
mpirun -n 2 ./test_sat_vapor_pres_r8
'

test_done
Loading