From 3767883f3ea5390c1edda7786e54d98b6a142385 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 8 Apr 2020 19:14:45 +0000 Subject: [PATCH] Replaced 0,6 with stderr,stdout - Following @marshallward's suggestion we now use stderr and stdout for directing messages in unit tests. These are set from output_unit and error_unit in iso_fortran_env rather than FMS/mpp.F90. The latter is normally used, and should be for error/warning/note messaging, but in the unit tests we need to be in direct control of where messages appear. --- src/ALE/MOM_remapping.F90 | 20 +++--- src/framework/MOM_diag_vkernels.F90 | 30 +++++---- src/framework/MOM_random.F90 | 16 +++-- src/framework/MOM_string_functions.F90 | 25 ++++--- src/tracer/MOM_lateral_boundary_diffusion.F90 | 10 +-- src/tracer/MOM_neutral_diffusion.F90 | 66 ++++++++++--------- 6 files changed, 92 insertions(+), 75 deletions(-) diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index e7e1052efe..65cf5b9d55 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -14,6 +14,8 @@ module MOM_remapping use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation use PQM_functions, only : PQM_reconstruction, PQM_boundary_extrapolation_v1 +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private #include @@ -1899,13 +1901,13 @@ logical function test_answer(verbose, n, u, u_true, label, tol) if (abs(u(k) - u_true(k)) > tolerance) test_answer = .true. enddo if (test_answer .or. verbose) then - write(*,'(a4,2a24,x,a)') 'k','Calculated value','Correct value',label + write(stdout,'(a4,2a24,x,a)') 'k','Calculated value','Correct value',label do k = 1, n if (abs(u(k) - u_true(k)) > tolerance) then - write(*,'(i4,1p2e24.16,a,1pe24.16,a)') k,u(k),u_true(k),' err=',u(k)-u_true(k),' < wrong' - write(0,'(i4,1p2e24.16,a,1pe24.16,a)') k,u(k),u_true(k),' err=',u(k)-u_true(k),' < wrong' + write(stdout,'(i4,1p2e24.16,a,1pe24.16,a)') k,u(k),u_true(k),' err=',u(k)-u_true(k),' < wrong' + write(stderr,'(i4,1p2e24.16,a,1pe24.16,a)') k,u(k),u_true(k),' err=',u(k)-u_true(k),' < wrong' else - write(*,'(i4,1p2e24.16)') k,u(k),u_true(k) + write(stdout,'(i4,1p2e24.16)') k,u(k),u_true(k) endif enddo endif @@ -1919,11 +1921,11 @@ subroutine dumpGrid(n,h,x,u) real, dimension(:), intent(in) :: x !< Interface delta real, dimension(:), intent(in) :: u !< Cell average values integer :: i - write(*,'("i=",20i10)') (i,i=1,n+1) - write(*,'("x=",20es10.2)') (x(i),i=1,n+1) - write(*,'("i=",5x,20i10)') (i,i=1,n) - write(*,'("h=",5x,20es10.2)') (h(i),i=1,n) - write(*,'("u=",5x,20es10.2)') (u(i),i=1,n) + write(stdout,'("i=",20i10)') (i,i=1,n+1) + write(stdout,'("x=",20es10.2)') (x(i),i=1,n+1) + write(stdout,'("i=",5x,20i10)') (i,i=1,n) + write(stdout,'("h=",5x,20es10.2)') (h(i),i=1,n) + write(stdout,'("u=",5x,20es10.2)') (u(i),i=1,n) end subroutine dumpGrid end module MOM_remapping diff --git a/src/framework/MOM_diag_vkernels.F90 b/src/framework/MOM_diag_vkernels.F90 index b134be5bd6..b7c1130521 100644 --- a/src/framework/MOM_diag_vkernels.F90 +++ b/src/framework/MOM_diag_vkernels.F90 @@ -4,6 +4,8 @@ module MOM_diag_vkernels ! This file is part of MOM6. See LICENSE.md for the license. +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private public diag_vkernels_unit_tests @@ -173,8 +175,8 @@ logical function diag_vkernels_unit_tests(verbose) v = verbose - write(6,*) '==== MOM_diag_kernels: diag_vkernels_unit_tests ==========' - if (v) write(6,*) '- - - - - - - - - - interpolation tests - - - - - - - - -' + write(stdout,*) '==== MOM_diag_kernels: diag_vkernels_unit_tests ==========' + if (v) write(stdout,*) '- - - - - - - - - - interpolation tests - - - - - - - - -' fail = test_interp(v,mv,'Identity: 3 layer', & 3, (/1.,2.,3./), (/1.,2.,3.,4./), & @@ -221,7 +223,7 @@ logical function diag_vkernels_unit_tests(verbose) 4, (/0.,2.,6.,0./), (/mv,1.,3.,8.,mv/) ) diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - if (v) write(6,*) '- - - - - - - - - - reintegration tests - - - - - - - - -' + if (v) write(stdout,*) '- - - - - - - - - - reintegration tests - - - - - - - - -' fail = test_reintegrate(v,mv,'Identity: 3 layer', & 3, (/1.,2.,3./), (/-5.,2.,1./), & @@ -273,7 +275,7 @@ logical function diag_vkernels_unit_tests(verbose) 3, (/0.,0.,0./), (/mv, mv, mv/) ) diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - if (.not. fail) write(*,*) 'Pass' + if (.not. fail) write(stdout,*) 'Pass' end function diag_vkernels_unit_tests @@ -302,15 +304,15 @@ logical function test_interp(verbose, missing_value, msg, nsrc, h_src, u_src, nd if (u_dest(k)/=u_true(k)) test_interp = .true. enddo if (verbose .or. test_interp) then - write(6,'(2a)') ' Test: ',msg - write(6,'(a3,3(a24))') 'k','u_result','u_true','error' + write(stdout,'(2a)') ' Test: ',msg + write(stdout,'(a3,3(a24))') 'k','u_result','u_true','error' do k=1,ndest+1 error = u_dest(k)-u_true(k) if (error==0.) then - write(6,'(i3,3(1pe24.16))') k,u_dest(k),u_true(k),u_dest(k)-u_true(k) + write(stdout,'(i3,3(1pe24.16))') k,u_dest(k),u_true(k),u_dest(k)-u_true(k) else - write(6,'(i3,3(1pe24.16),x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' - write(0,'(i3,3(1pe24.16),x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' + write(stdout,'(i3,3(1pe24.16),x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' + write(stderr,'(i3,3(1pe24.16),x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' endif enddo endif @@ -341,15 +343,15 @@ logical function test_reintegrate(verbose, missing_value, msg, nsrc, h_src, uh_s if (uh_dest(k)/=uh_true(k)) test_reintegrate = .true. enddo if (verbose .or. test_reintegrate) then - write(6,'(2a)') ' Test: ',msg - write(6,'(a3,3(a24))') 'k','uh_result','uh_true','error' + write(stdout,'(2a)') ' Test: ',msg + write(stdout,'(a3,3(a24))') 'k','uh_result','uh_true','error' do k=1,ndest error = uh_dest(k)-uh_true(k) if (error==0.) then - write(6,'(i3,3(1pe24.16))') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k) + write(stdout,'(i3,3(1pe24.16))') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k) else - write(6,'(i3,3(1pe24.16),x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' - write(0,'(i3,3(1pe24.16),x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' + write(stdout,'(i3,3(1pe24.16),x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' + write(stderr,'(i3,3(1pe24.16),x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' endif enddo endif diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index 8dafc530ba..c37893012e 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -11,6 +11,8 @@ module MOM_random use MersenneTwister_mod, only : getRandomReal ! Generates a random number use MersenneTwister_mod, only : getRandomPositiveInt ! Generates a random positive integer +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private public :: random_0d_constructor @@ -205,7 +207,7 @@ logical function random_unit_tests(verbose) HI%jdg_offset = 0 random_unit_tests = .false. - stdunit = 6 + stdunit = stdout write(stdunit,'(1x,a)') '==== MOM_random: random_unit_tests =======================' if (verbose) write(stdunit,'(1x,"random: ",a)') '-- Time-based seeds ---------------------' @@ -417,17 +419,17 @@ logical function test_fn(verbose, good, label, rvalue, ivalue) if (present(ivalue)) then if (.not. good) then - write(6,'(1x,a,i10,1x,a,a)') 'random: result =',ivalue,label,' <------- FAIL!' - write(0,'(1x,a,i10,1x,a,a)') 'random: result =',ivalue,label,' <------- FAIL!' + write(stdout,'(1x,a,i10,1x,a,a)') 'random: result =',ivalue,label,' <------- FAIL!' + write(stderr,'(1x,a,i10,1x,a,a)') 'random: result =',ivalue,label,' <------- FAIL!' elseif (verbose) then - write(6,'(1x,a,i10,1x,a)') 'random: result =',ivalue,label + write(stdout,'(1x,a,i10,1x,a)') 'random: result =',ivalue,label endif else if (.not. good) then - write(6,'(1x,a,1pe15.8,1x,a,a)') 'random: result =',rvalue,label,' <------- FAIL!' - write(0,'(1x,a,1pe15.8,1x,a,a)') 'random: result =',rvalue,label,' <------- FAIL!' + write(stdout,'(1x,a,1pe15.8,1x,a,a)') 'random: result =',rvalue,label,' <------- FAIL!' + write(stderr,'(1x,a,1pe15.8,1x,a,a)') 'random: result =',rvalue,label,' <------- FAIL!' elseif (verbose) then - write(6,'(1x,a,1pe15.8,1x,a)') 'random: result =',rvalue,label + write(stdout,'(1x,a,1pe15.8,1x,a)') 'random: result =',rvalue,label endif endif test_fn = .not. good diff --git a/src/framework/MOM_string_functions.F90 b/src/framework/MOM_string_functions.F90 index 33f9b69376..1293499930 100644 --- a/src/framework/MOM_string_functions.F90 +++ b/src/framework/MOM_string_functions.F90 @@ -3,6 +3,8 @@ module MOM_string_functions ! This file is part of MOM6. See LICENSE.md for the license. +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private public lowercase, uppercase @@ -319,7 +321,7 @@ logical function string_functions_unit_tests(verbose) logical :: fail, v fail = .false. v = verbose - write(*,*) '==== MOM_string_functions: string_functions_unit_tests ===' + write(stdout,*) '==== MOM_string_functions: string_functions_unit_tests ===' fail = fail .or. localTestS(v,left_int(-1),'-1') fail = fail .or. localTestS(v,left_ints(i(:)),'-1, 1, 3, 3, 0') fail = fail .or. localTestS(v,left_real(0.),'0.0') @@ -349,7 +351,7 @@ logical function string_functions_unit_tests(verbose) fail = fail .or. localTestR(v,extract_real("1.,2.",",",2),2.) fail = fail .or. localTestR(v,extract_real("1.,2.",",",3),0.) fail = fail .or. localTestR(v,extract_real("1.,2.",",",4,4.),4.) - if (.not. fail) write(*,*) 'Pass' + if (.not. fail) write(stdout,*) 'Pass' string_functions_unit_tests = fail end function string_functions_unit_tests @@ -361,10 +363,10 @@ logical function localTestS(verbose,str1,str2) localTestS=.false. if (trim(str1)/=trim(str2)) localTestS=.true. if (localTestS .or. verbose) then - write(*,*) '>'//trim(str1)//'<' + write(stdout,*) '>'//trim(str1)//'<' if (localTestS) then - write(*,*) trim(str1),':',trim(str2), '<-- FAIL' - write(0,*) trim(str1),':',trim(str2), '<-- FAIL' + write(stdout,*) trim(str1),':',trim(str2), '<-- FAIL' + write(stderr,*) trim(str1),':',trim(str2), '<-- FAIL' endif endif end function localTestS @@ -377,10 +379,10 @@ logical function localTestI(verbose,i1,i2) localTestI=.false. if (i1/=i2) localTestI=.true. if (localTestI .or. verbose) then - write(*,*) i1,i2 + write(stdout,*) i1,i2 if (localTestI) then - write(*,*) i1,'!=',i2, '<-- FAIL' - write(0,*) i1,'!=',i2, '<-- FAIL' + write(stdout,*) i1,'!=',i2, '<-- FAIL' + write(stderr,*) i1,'!=',i2, '<-- FAIL' endif endif end function localTestI @@ -393,8 +395,11 @@ logical function localTestR(verbose,r1,r2) localTestR=.false. if (r1/=r2) localTestR=.true. if (localTestR .or. verbose) then - write(*,*) r1,r2 - if (localTestR) write(*,*) r1,'!=',r2, '<-- FAIL' + write(stdout,*) r1,r2 + if (localTestR) then + write(stdout,*) r1,'!=',r2, '<-- FAIL' + write(stderr,*) r1,'!=',r2, '<-- FAIL' + endif endif end function localTestR diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 9c53e0e514..443b9108d2 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -24,6 +24,8 @@ module MOM_lateral_boundary_diffusion use MOM_energetic_PBL, only : energetic_PBL_get_MLD, energetic_PBL_CS use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private public near_boundary_unit_tests, lateral_boundary_diffusion, lateral_boundary_diffusion_init @@ -987,7 +989,7 @@ logical function test_layer_fluxes(verbose, nk, test_name, F_calc, F_ans) real, dimension(nk), intent(in) :: F_ans !< Fluxes of the unitless tracer calculated by hand [s^-1] ! Local variables integer :: k - integer, parameter :: stdunit = 6 + integer, parameter :: stdunit = stdout test_layer_fluxes = .false. do k=1,nk @@ -997,8 +999,8 @@ logical function test_layer_fluxes(verbose, nk, test_name, F_calc, F_ans) write(stdunit,10) k, F_calc(k), F_ans(k) ! ### Once these unit tests are passing, and failures are caught properly, ! we will post failure notifications to both stdout and stderr. - !write(0,*) "MOM_lateral_boundary_diffusion, UNIT TEST FAILED: ", test_name - !write(0,10) k, F_calc(k), F_ans(k) + !write(stderr,*) "MOM_lateral_boundary_diffusion, UNIT TEST FAILED: ", test_name + !write(stderr,10) k, F_calc(k), F_ans(k) elseif (verbose) then write(stdunit,10) k, F_calc(k), F_ans(k) endif @@ -1021,7 +1023,7 @@ logical function test_boundary_k_range(k_top, zeta_top, k_bot, zeta_bot, k_top_a character(len=80) :: test_name !< Name of the unit test logical :: verbose !< If true always print output - integer, parameter :: stdunit = 6 + integer, parameter :: stdunit = stdout test_boundary_k_range = k_top .ne. k_top_ans test_boundary_k_range = test_boundary_k_range .or. (zeta_top .ne. zeta_top_ans) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 26873900cc..cd32f81a32 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -28,6 +28,9 @@ module MOM_neutral_diffusion use MOM_energetic_PBL, only : energetic_PBL_get_MLD, energetic_PBL_CS use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member use MOM_lateral_boundary_diffusion, only : boundary_k_range, SURFACE, BOTTOM + +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private #include @@ -1120,7 +1123,7 @@ real function interpolate_for_nondim_position(dRhoNeg, Pneg, dRhoPos, Ppos) if (PposdRhoPos) then - write(0,*) 'dRhoNeg, Pneg, dRhoPos, Ppos=',dRhoNeg, Pneg, dRhoPos, Ppos + write(stderr,*) 'dRhoNeg, Pneg, dRhoPos, Ppos=',dRhoNeg, Pneg, dRhoPos, Ppos elseif (dRhoNeg>dRhoPos) then stop 'interpolate_for_nondim_position: Houston, we have a problem! dRhoNeg>dRhoPos' endif @@ -1276,7 +1279,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hcol_l, Tr(kl_right, ki_right), Sr(kl_right, ki_right), Pres_r(kl_right,ki_right), & Tl(kl_left, ki_left), Sl(kl_left, ki_left) , Pres_l(kl_left,ki_left), & dRho) - if (CS%debug) write(*,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",dRho, & + if (CS%debug) write(stdout,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",dRho, & "kl_left=",kl_left, " ki_left=",ki_left," kl_right=",kl_right, " ki_right=",ki_right ! Which column has the lighter surface for the current indexes, kr and kl if (.not. reached_bottom) then @@ -1308,11 +1311,11 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hcol_l, KoL(k_surface) = kl_left if (CS%debug) then - write(*,'(A,I2)') "Searching left layer ", kl_left - write(*,'(A,I2,X,I2)') "Searching from right: ", kl_right, ki_right - write(*,*) "Temp/Salt Reference: ", Tr(kl_right,ki_right), Sr(kl_right,ki_right) - write(*,*) "Temp/Salt Top L: ", Tl(kl_left,1), Sl(kl_left,1) - write(*,*) "Temp/Salt Bot L: ", Tl(kl_left,2), Sl(kl_left,2) + write(stdout,'(A,I2)') "Searching left layer ", kl_left + write(stdout,'(A,I2,X,I2)') "Searching from right: ", kl_right, ki_right + write(stdout,*) "Temp/Salt Reference: ", Tr(kl_right,ki_right), Sr(kl_right,ki_right) + write(stdout,*) "Temp/Salt Top L: ", Tl(kl_left,1), Sl(kl_left,1) + write(stdout,*) "Temp/Salt Bot L: ", Tl(kl_left,2), Sl(kl_left,2) endif call increment_interface(nk, kl_right, ki_right, reached_bottom, searching_right_column, searching_left_column) lastP_left = PoL(k_surface) @@ -1331,11 +1334,11 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hcol_l, KoR(k_surface) = kl_right if (CS%debug) then - write(*,'(A,I2)') "Searching right layer ", kl_right - write(*,'(A,I2,X,I2)') "Searching from left: ", kl_left, ki_left - write(*,*) "Temp/Salt Reference: ", Tl(kl_left,ki_left), Sl(kl_left,ki_left) - write(*,*) "Temp/Salt Top L: ", Tr(kl_right,1), Sr(kl_right,1) - write(*,*) "Temp/Salt Bot L: ", Tr(kl_right,2), Sr(kl_right,2) + write(stdout,'(A,I2)') "Searching right layer ", kl_right + write(stdout,'(A,I2,X,I2)') "Searching from left: ", kl_left, ki_left + write(stdout,*) "Temp/Salt Reference: ", Tl(kl_left,ki_left), Sl(kl_left,ki_left) + write(stdout,*) "Temp/Salt Top L: ", Tr(kl_right,1), Sr(kl_right,1) + write(stdout,*) "Temp/Salt Bot L: ", Tr(kl_right,2), Sr(kl_right,2) endif call increment_interface(nk, kl_left, ki_left, reached_bottom, searching_left_column, searching_right_column) lastP_right = PoR(k_surface) @@ -1344,7 +1347,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, Pres_l, hcol_l, else stop 'Else what?' endif - if (CS%debug) write(*,'(A,I3,A,ES16.6,A,I2,A,ES16.6)') "KoL:", KoL(k_surface), " PoL:", PoL(k_surface), & + if (CS%debug) write(stdout,'(A,I3,A,ES16.6,A,I2,A,ES16.6)') "KoL:", KoL(k_surface), " PoL:", PoL(k_surface), & " KoR:", KoR(k_surface), " PoR:", PoR(k_surface) endif ! Effective thickness @@ -2039,7 +2042,6 @@ logical function neutral_diffusion_unit_tests(verbose) neutral_diffusion_unit_tests = .false. .or. & ndiff_unit_tests_continuous(verbose) .or. ndiff_unit_tests_discontinuous(verbose) - end function neutral_diffusion_unit_tests !> Returns true if unit tests of neutral_diffusion functions fail. Otherwise returns false. @@ -2064,7 +2066,7 @@ logical function ndiff_unit_tests_continuous(verbose) v = verbose ndiff_unit_tests_continuous = .false. ! Normally return false - write(*,*) '==== MOM_neutral_diffusion: ndiff_unit_tests_continuous =' + write(stdout,*) '==== MOM_neutral_diffusion: ndiff_unit_tests_continuous =' ndiff_unit_tests_continuous = ndiff_unit_tests_continuous .or. & test_fv_diff(v,1.,1.,1., 0.,1.,2., 1., 'FV: Straight line on uniform grid') @@ -2304,7 +2306,7 @@ logical function ndiff_unit_tests_continuous(verbose) (/0.,0.,0.,0.,0.,6.,0./), & ! hEff 'Two unstable mixed layers') - if (.not. ndiff_unit_tests_continuous) write(*,*) 'Pass' + if (.not. ndiff_unit_tests_continuous) write(stdout,*) 'Pass' end function ndiff_unit_tests_continuous @@ -2333,7 +2335,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) v = verbose ndiff_unit_tests_discontinuous = .false. ! Normally return false - write(*,*) '==== MOM_neutral_diffusion: ndiff_unit_tests_discontinuous =' + write(stdout,*) '==== MOM_neutral_diffusion: ndiff_unit_tests_discontinuous =' ! Unit tests for find_neutral_surface_positions_discontinuous ! Salinity is 0 for all these tests @@ -2555,7 +2557,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) find_neutral_pos_linear(CS, 0., 10., 35., 0., 0., 0.8, & 0., 0., 1.0, 10., 0., 0.5, & (/12.,0./), (/34.,2./)), "Salt stratified Linearized Alpha/Beta")) - if (.not. ndiff_unit_tests_discontinuous) write(*,*) 'Pass' + if (.not. ndiff_unit_tests_discontinuous) write(stdout,*) 'Pass' end function ndiff_unit_tests_discontinuous @@ -2579,8 +2581,8 @@ logical function test_fv_diff(verbose, hkm1, hk, hkp1, Skm1, Sk, Skp1, Ptrue, ti test_fv_diff = (Pret /= Ptrue) if (test_fv_diff .or. verbose) then - stdunit = 6 - if (test_fv_diff) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_fv_diff) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_fv_diff) then write(stdunit,'(2(x,a,f20.16),x,a)') 'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' @@ -2611,8 +2613,8 @@ logical function test_fvlsq_slope(verbose, hkm1, hk, hkp1, Skm1, Sk, Skp1, Ptrue test_fvlsq_slope = (Pret /= Ptrue) if (test_fvlsq_slope .or. verbose) then - stdunit = 6 - if (test_fvlsq_slope) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_fvlsq_slope) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_fvlsq_slope) then write(stdunit,'(2(x,a,f20.16),x,a)') 'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' @@ -2641,8 +2643,8 @@ logical function test_ifndp(verbose, rhoNeg, Pneg, rhoPos, Ppos, Ptrue, title) test_ifndp = (Pret /= Ptrue) if (test_ifndp .or. verbose) then - stdunit = 6 - if (test_ifndp) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_ifndp) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_ifndp) then write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15),x,a)') & @@ -2672,8 +2674,8 @@ logical function test_data1d(verbose, nk, Po, Ptrue, title) enddo if (test_data1d .or. verbose) then - stdunit = 6 - if (test_data1d) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_data1d) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title do k = 1,nk if (Po(k) /= Ptrue(k)) then @@ -2707,8 +2709,8 @@ logical function test_data1di(verbose, nk, Po, Ptrue, title) enddo if (test_data1di .or. verbose) then - stdunit = 6 - if (test_data1di) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_data1di) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title do k = 1,nk if (Po(k) /= Ptrue(k)) then @@ -2753,8 +2755,8 @@ logical function test_nsp(verbose, ns, KoL, KoR, pL, pR, hEff, KoL0, KoR0, pL0, enddo if (test_nsp .or. verbose) then - stdunit = 6 - if (test_nsp) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_nsp) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title do k = 1,ns this_row_failed = compare_nsp_row(KoL(k), KoR(k), pL(k), pR(k), KoL0(k), KoR0(k), pL0(k), pR0(k)) @@ -2802,7 +2804,9 @@ logical function test_rnp(expected_pos, test_pos, title) real, intent(in) :: test_pos !< The position returned by the code character(len=*), intent(in) :: title !< A label for this test ! Local variables - integer :: stdunit = 6 ! Output to standard error + integer :: stdunit + + stdunit = stdout ! Output to standard error test_rnp = ABS(expected_pos - test_pos) > 2*EPSILON(test_pos) if (test_rnp) then write(stdunit,'(A, f20.16, " .neq. ", f20.16, " <-- WRONG")') title, expected_pos, test_pos