remove duplicate pe in error message, add tests

NOAA-GFDL · Dec 3, 2024 · 9172483 · 9172483
1 parent 2bb4762
commit 9172483
Show file tree

Hide file tree

Showing 3 changed files with 65 additions and 8 deletions.
diff --git a/sat_vapor_pres/include/sat_vapor_pres.inc b/sat_vapor_pres/include/sat_vapor_pres.inc
@@ -1892,7 +1892,7 @@
 
  ind = int( dtinvll*(temp-tminll+tepsll) )
  if (ind < 0 .or. ind > nlim) then
-   write(output_msg,'(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
 
@@ -1917,7 +1917,7 @@
  do i=1,size(temp)
    ind = int( dtinvll*(temp(i)-tminll+tepsll) )
    if (ind < 0 .or. ind > nlim) then
-     write(output_msg,'(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
@@ -1944,7 +1944,7 @@
  do i=1,size(temp,1)
    ind = int( dtinvll*(temp(i,j)-tminll+tepsll) )
    if (ind < 0 .or. ind > nlim) then
-     write(output_msg,'(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
@@ -1973,8 +1973,7 @@
  do i=1,size(temp,1)
    ind = int( dtinvll*(temp(i,j,k)-tminll+tepsll) )
    if (ind < 0 .or. ind > nlim) then
-     write(output_msg,'(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

diff --git a/test_fms/sat_vapor_pres/test_sat_vapor_pres.F90 b/test_fms/sat_vapor_pres/test_sat_vapor_pres.F90
@@ -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, &
@@ -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) )
@@ -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)
@@ -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')
@@ -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')
@@ -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')

diff --git a/test_fms/sat_vapor_pres/test_sat_vapor_pres.sh b/test_fms/sat_vapor_pres/test_sat_vapor_pres.sh
@@ -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
 
@@ -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