Debug ppoly0 values

src/ALE/MOM_remapping.F90

@@ -1465,7 +1465,7 @@ logical function remapping_unit_tests(verbose)
   if (verbose) write(stdout,*) '  ===== MOM_remapping: remapping_unit_tests ================='
 
   ! This line carries out tests on some older remapping schemes.
-  call test%test( remapping_attic_unit_tests(verbose) )
+  call test%test( remapping_attic_unit_tests(verbose), 'remapping attic')
 
   if (verbose) write(stdout,*) '  - - - - - 1st generation tests - - - - -'
 
@@ -1792,6 +1792,8 @@ logical function remapping_unit_tests(verbose)
   ! u_sub =     |1|   2     |3|  4    | 5.5 |  6  |
   call PLM_reconstruction(3, (/2.,2.,1./), (/2.,4.,5.5/), ppoly0_E, ppoly0_coefs, h_neglect )
   call PLM_boundary_extrapolation(3, (/2.,2.,1./),(/2.,4.,5.5/), ppoly0_E, ppoly0_coefs, h_neglect)
+  call test%real_arr(3, ppoly0_E(:,1), (/1.,3.,5./), 'ppoly0_E(:,1)')
+  call test%real_arr(3, ppoly0_E(:,2), (/3.,5.,6./), 'ppoly0_E(:,1)')
   allocate(u_sub(6), uh_sub(6))
   call remap_src_to_sub_grid(3, (/2.,2.,1./), (/2.,4.,5.5/), ppoly0_E, ppoly0_coefs, 3, h_sub, &
                              h0_eff, isrc_start, isrc_end, isrc_max, isub_src, &

src/framework/testing_type.F90

@@ -28,6 +28,10 @@ module testing_type
   integer :: stdout = 6
   !> If true, stop instantly
   logical :: stop_instantly = .false.
+  !> Record instances that fail
+  integer :: ifailed(100) = 0.
+  !> Record label of first instance that failed
+  character(len=:), allocatable :: label_first_fail
 
   contains
     procedure :: test => test           !< Update the testing state
@@ -41,14 +45,17 @@ module testing_type
 contains
 
 !> Update the state with "test"
-subroutine test(this, state)
-  class(testing), intent(inout) :: this  !< This testing class
-  logical,        intent(in)    :: state !< True to indicate a fail, false otherwise
+subroutine test(this, state, label)
+  class(testing),   intent(inout) :: this  !< This testing class
+  logical,          intent(in)    :: state !< True to indicate a fail, false otherwise
+  character(len=*), intent(in)    :: label !< Message
 
   this%num_tests_checked = this%num_tests_checked + 1
   if (state) then
     this%state = .true.
     this%num_tests_failed = this%num_tests_failed + 1
+    this%ifailed( this%num_tests_failed ) = this%num_tests_checked
+    if (this%num_tests_failed == 1) this%label_first_fail = label
   endif
   if (this%stop_instantly .and. this%state) stop 1
 end subroutine test
@@ -85,10 +92,15 @@ end function outcome
 logical function summarize(this, label)
   class(testing),  intent(inout) :: this  !< This testing class
   character(len=*),   intent(in) :: label !< Message
+  integer :: i
 
   if (this%state) then
     write(this%stdout,'(a," : ",a,", ",i4," failed of ",i4," tested")') &
          red('FAIL'), trim(label), this%num_tests_failed, this%num_tests_checked
+    write(this%stdout,'(a,100i4)') 'Failed tests:',(this%ifailed(i),i=1,this%num_tests_failed)
+    write(this%stdout,'(a,a)') 'First failed test: ',trim(this%label_first_fail)
+    write(this%stderr,'(a,100i4)') 'Failed tests:',(this%ifailed(i),i=1,this%num_tests_failed)
+    write(this%stderr,'(a,a)') 'First failed test: ',trim(this%label_first_fail)
     write(this%stderr,'(a," : ",a)') trim(label),'FAILED'
   else
     write(this%stdout,'(a," : ",a,", all ",i4," tests passed")') &
@@ -153,7 +165,7 @@ subroutine real_arr(this, n, u_test, u_true, label, tol)
     enddo
   endif
 
-  call this%test( this_test ) ! Updates state and counters in this
+  call this%test( this_test, label ) ! Updates state and counters in this
 end subroutine real_arr
 
 !> Compare i_test to i_true and report and return true if a difference is found
@@ -188,7 +200,7 @@ subroutine int_arr(this, n, i_test, i_true, label)
      write(this%stderr,'("   FAIL --->        error =",30i3)') i_test(:) - i_true(:)
    endif
 
-  call this%test( this_test ) ! Updates state and counters in this
+  call this%test( this_test, label ) ! Updates state and counters in this
 end subroutine int_arr
 
 end module testing_type